home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
tex
/
ptf12.zip
/
PTFBODY.SRC
< prev
next >
Wrap
Text File
|
1990-05-12
|
176KB
|
6,277 lines
--::::::::::
--clp_body.a
--::::::::::
-- **********************************************
-- * *
-- * COMMAND_LINE_PROCESSOR * BODY
-- * *
-- **********************************************
with CLI; -- from CLI2.SRC
with TEXT_IO;
package body COMMAND_LINE_PROCESSOR is
NUMBER_OF_FILE_NAME_TOKENS : NATURAL;
INIT_DONE : BOOLEAN := FALSE;
OUTPUT_FILE_EXISTS : BOOLEAN := FALSE;
type FNAME (LEN : NATURAL);
type FNAME_POINTER is access FNAME;
type FNAME (LEN : NATURAL) is
record
NAME : STRING (1 .. LEN);
NEXT : FNAME_POINTER;
end record;
FIRST_FILE : FNAME_POINTER := null;
CURRENT_FILE : FNAME_POINTER := null;
LAST_FILE : FNAME_POINTER := null;
-- ...........................................
-- . .
-- . ADD_FILE_NAME . SPEC & BODY
-- . .
-- ...........................................
procedure ADD_FILE_NAME (FILE_NAME : in STRING) is
--| Purpose
--| ADD_FILE_NAME adds the named file to the file list, building
--| onto a linked-list. If FILE_NAME is an include file,
--| all files named by this include file and the include files
--| it references are added to the list.
--|
--| Notes
--| ADD_FILE_NAME is recursive.
FD : TEXT_IO.FILE_TYPE;
type INLINE is
record
CONTENT : STRING (1 .. MAX_FILE_NAME_LENGTH);
LAST : NATURAL;
end record;
FILE : INLINE;
-- ...........................................
-- . .
-- . ADD_FILE_NAME.IS_COMMENT . SPEC & BODY
-- . .
-- ...........................................
function IS_COMMENT (ITEM : in INLINE) return BOOLEAN is
--| Purpose
--| Determine if the indicated ITEM is a comment line
--| (begins with a "--").
begin
return ITEM.LAST > 1 and then ITEM.CONTENT(1..2) = "--";
end IS_COMMENT;
-- ...........................................
-- . .
-- . ADD_FILE_NAME.ADD_NAME_TO_LIST . SPEC & BODY
-- . .
-- ...........................................
procedure ADD_NAME_TO_LIST (FILE_NAME : in STRING) is
--| Purpose
--| Add the indicated FILE_NAME to the linked list.
TEMP : FNAME_POINTER;
begin
begin
TEMP := new FNAME (FILE_NAME'LENGTH);
TEMP.NAME := FILE_NAME;
TEMP.NEXT := null; -- not necessary, but clear
exception
when others => raise ALLOCATION_PROBLEM;
end;
if FIRST_FILE = null then
FIRST_FILE := TEMP;
LAST_FILE := FIRST_FILE;
CURRENT_FILE := FIRST_FILE;
else
LAST_FILE.NEXT := TEMP;
LAST_FILE := TEMP;
end if;
end ADD_NAME_TO_LIST;
begin -- ADD_FILE_NAME
if FILE_NAME (FILE_NAME'FIRST) /= INCLUDE_FILE_PREFIX then
ADD_NAME_TO_LIST (FILE_NAME);
else
-- Process include file
begin
TEXT_IO.OPEN (FD, TEXT_IO.IN_FILE,
FILE_NAME (FILE_NAME'FIRST + 1 .. FILE_NAME'LAST));
exception
when others =>
raise INCLUDE_FILE_NOT_FOUND;
end;
-- Loop through file
while not TEXT_IO.END_OF_FILE (FD) loop
TEXT_IO.GET_LINE (FD, FILE.CONTENT, FILE.LAST);
if FILE.LAST > 0 and then not IS_COMMENT(FILE) then
if FILE.CONTENT (1) = INCLUDE_FILE_PREFIX then
ADD_FILE_NAME (FILE.CONTENT (1 .. FILE.LAST));
else
ADD_NAME_TO_LIST (FILE.CONTENT (1 .. FILE.LAST));
end if;
end if;
end loop;
-- Close include file
TEXT_IO.CLOSE (FD);
end if;
exception
when INCLUDE_FILE_NOT_FOUND | ALLOCATION_PROBLEM => raise;
when others => raise UNEXPECTED_ERROR;
end ADD_FILE_NAME;
-- ..............................................
-- . .
-- . INITIALIZE . BODY
-- . .
-- ..............................................
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_KIND : in COMMAND_LINE_LAYOUT
:= ONE_OUTPUT_FILE) is
begin
if COMMAND_KIND = ONE_OUTPUT_FILE then
CLI.INITIALIZE(PROGRAM_NAME,
"Enter input file names and output file name: ");
NUMBER_OF_FILE_NAME_TOKENS := CLI.ARGC - 1;
for I in 1 .. NUMBER_OF_FILE_NAME_TOKENS - 1 loop
ADD_FILE_NAME(CLI.ARGV(I));
end loop;
OUTPUT_FILE_EXISTS := TRUE;
else
CLI.INITIALIZE(PROGRAM_NAME,
"Enter input file names: ");
NUMBER_OF_FILE_NAME_TOKENS := CLI.ARGC - 1;
for I in 1 .. NUMBER_OF_FILE_NAME_TOKENS loop
ADD_FILE_NAME(CLI.ARGV(I));
end loop;
OUTPUT_FILE_EXISTS := FALSE;
end if;
INIT_DONE := TRUE;
exception
when ALLOCATION_PROBLEM => raise;
when others => raise UNEXPECTED_ERROR;
end INITIALIZE;
-- ..............................................
-- . .
-- . RESET . BODY
-- . .
-- ..............................................
procedure RESET is
begin
if not INIT_DONE then
raise INIT_ERROR;
else
CURRENT_FILE := FIRST_FILE;
end if;
exception
when INIT_ERROR => raise;
when others => raise UNEXPECTED_ERROR;
end RESET;
-- ..............................................
-- . .
-- . IS_END . BODY
-- . .
-- ..............................................
function IS_END return BOOLEAN is
begin
if not INIT_DONE then
raise INIT_ERROR;
else
return CURRENT_FILE = null;
end if;
exception
when INIT_ERROR => raise;
when others => raise UNEXPECTED_ERROR;
end IS_END;
-- ..............................................
-- . .
-- . FILE_NAME . BODY
-- . .
-- ..............................................
function FILE_NAME return STRING is
TEMP : FNAME_POINTER;
begin
if not INIT_DONE then
raise INIT_ERROR;
else
if IS_END then
raise END_OF_FILE_LIST;
end if;
TEMP := CURRENT_FILE;
CURRENT_FILE := CURRENT_FILE.NEXT;
return TEMP.NAME;
end if;
exception
when INIT_ERROR => raise;
when END_OF_FILE_LIST => raise;
when others => raise UNEXPECTED_ERROR;
end FILE_NAME;
-- ..............................................
-- . .
-- . OUTPUT_FILE_NAME . BODY
-- . .
-- ..............................................
function OUTPUT_FILE_NAME return STRING is
begin
if not INIT_DONE then
raise INIT_ERROR;
else
if OUTPUT_FILE_EXISTS then
return CLI.ARGV(NUMBER_OF_FILE_NAME_TOKENS);
else
return "";
end if;
end if;
exception
when INIT_ERROR => raise;
when others => raise UNEXPECTED_ERROR;
end OUTPUT_FILE_NAME;
-- ..............................................
-- . .
-- . FILE_NAME_COUNT . BODY
-- . .
-- ..............................................
function FILE_NAME_COUNT return NATURAL is
begin
if not INIT_DONE then
raise INIT_ERROR;
else
return NUMBER_OF_FILE_NAME_TOKENS;
end if;
exception
when INIT_ERROR => raise;
when others => raise UNEXPECTED_ERROR;
end FILE_NAME_COUNT;
end COMMAND_LINE_PROCESSOR;
--::::::::::
--cmd_body.a
--::::::::::
-- **********************************
-- * *
-- * Command * BODY
-- * *
-- **********************************
with Console;
with Contents;
with Environment;
with Error_Log;
with Index;
with Input_File;
with Macro;
with Parse;
with Variable;
with Word_Processor;
package body Command is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Add Disable Underline
--| 02/26/90 Rick Conn Add trim of tail as well as front
Default_Bottom
: constant NATURAL
:= Formatted_Output_File.Page_Attribute_Defaults
(Formatted_Output_File.Bottom_Margin);
Default_Footer
: constant NATURAL
:= Formatted_Output_File.Page_Attribute_Defaults
(Formatted_Output_File.Footer_Lines);
Default_Header
: constant NATURAL
:= Formatted_Output_File.Page_Attribute_Defaults
(Formatted_Output_File.Header_Lines);
Default_Top
: constant NATURAL
:= Formatted_Output_File.Page_Attribute_Defaults
(Formatted_Output_File.Top_Margin);
Default_Contents_Indentation
: constant NATURAL
:= 3;
Is_Bolding
: BOOLEAN
:= true;
Is_Underlining
: BOOLEAN
:= true;
Last_Contents_Indent
: NATURAL
:= 0;
Index_File_Name
: constant STRING
:= "ptf.idx";
Index_Is_Open
: BOOLEAN
:= false;
Index_Line_Length
: NATURAL
:= 35;
package Fof
renames Formatted_Output_File;
use Command_Symbols; -- for visibility of "="
use Formatted_Output_File;
use Macro;
use Word_Processor;
-- ..................................
-- . .
-- . Convert . SPEC & BODY
-- . .
-- ..................................
function Convert
( Item : in STRING )
return Command_Text is
--| Purpose
--| Convert converts the passed string into a string of type
--| COMMAND_TEXT. If the passed string is longer than COMMAND_TEXT,
--| it is truncated;
--|
--| Exceptions (none)
--| Notes (none)
Result
: Command_Text
:= (others => ' ');
Item_Start
: NATURAL
:= Item'First;
Item_End
: NATURAL
:= Item'First + Command_Text'Length - 1;
begin -- Convert
if Item'Length <= Command_Text'Length then
Result(1 .. Item'Length) := Item;
else
Result := Item(Item_Start .. Item_End);
end if;
return Result;
end Convert;
-- ..................................
-- . .
-- . Spaces . SPEC & BODY
-- . .
-- ..................................
function Spaces
( Number : in NATURAL )
return STRING is
--| Purpose
--| Spaces generates a string of the indicated number of spaces.
--|
--| Exceptions (none)
--| Notes (none)
Result
: STRING (1 .. Number + 1)
:= (others => ' ');
begin -- Spaces
return Result(1 .. Number);
end Spaces;
-- ..................................
-- . .
-- . To_Nat . SPEC & BODY
-- . .
-- ..................................
function To_Nat
( Number : in STRING )
return NATURAL is
--| Purpose
--| To_Nat converts a string of digits to a natural number with
--| error checking.
--|
--| Exceptions (none)
--| Notes (none)
Result
: NATURAL;
begin -- To_Nat
Result := NATURAL'Value(Number);
return Result;
exception -- To_Nat -- To_Nat
when others =>
Error_Log.Write_Error(Error_Number & """" & Number & """");
return 0;
end To_Nat;
-- ..................................
-- . .
-- . Adjust . SPEC & BODY
-- . .
-- ..................................
function Adjust
( Original_Value : in NATURAL;
Text : in STRING )
return NATURAL is
--| Purpose
--| Adjust accepts strings of the form "n", "+n", and "-n",
--| converts the "n" to a natural number, and, if "+n" or "-n",
--| adjusts the Original_Value by that amount. If "n", it ignores
--| the Original_Value and just returns that amount.
--|
--| Exceptions (none)
--| Notes (none)
Result
: NATURAL
:= Original_Value;
Temp
: NATURAL;
type OPERATION is
( INCREMENT, DECREMENT, SET );
Op
: OPERATION;
Scan_Start
: NATURAL;
Scan_End
: NATURAL;
begin -- Adjust
if Text'Length > 0 then
case Text(Text'First) is
when '+' =>
Op := INCREMENT;
Scan_Start := Text'First + 1;
when '-' =>
Op := DECREMENT;
Scan_Start := Text'First + 1;
when others =>
Op := SET;
Scan_Start := Text'First;
end case;
Scan_End := Text'Last;
for I in Scan_Start .. Text'Last loop
if Text(I) <= ' ' then
Scan_End := I - 1;
exit;
end if;
end loop;
Temp := To_Nat(Text(Scan_Start .. Scan_End));
case Op is
when INCREMENT =>
Result := Original_Value + Temp;
when DECREMENT =>
if Original_Value >= Temp then
Result := Original_Value - Temp;
else
Result := 0;
end if;
when SET =>
Result := Temp;
end case;
end if;
return Result;
end Adjust;
-- ..................................
-- . .
-- . Identify . BODY
-- . .
-- ..................................
function Identify
( Item : in STRING )
return Command_Id is
--| Notes (none)
Target_Command
: Command_Text
:= Convert(Item);
Result
: Command_Id
:= Unknown;
begin -- Identify
for I in Cl'range loop
if Target_Command = Cl(I).Name then
Result := Cl(I).Id;
exit;
end if;
end loop;
return Result;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Identify);
return Unknown;
end Identify;
-- ..................................
-- . .
-- . Process . BODY
-- . .
-- ..................................
procedure Process
( Id : in Command_Id;
Line_Tail : in STRING;
Target : in out Formatted_Output_File.File;
Input_File_Id : in out Input_File.File_Type ) is
--| Notes (none)
Temp
: NATURAL;
Temp1
: NATURAL;
Old_Value
: NATURAL;
Line_To_Write
: STRING (1 .. Ltw_Length);
Ltw_Last
: NATURAL;
Mid
: Macro.Macro_Id;
Mid_Read
: Macro.Macro_Id;
Mstatus
: Macro.Macro_Status;
Inline
: STRING (1 .. 200);
Inlast
: NATURAL;
Inline_Verb
: STRING (1 .. 200);
Inlast_Verb
: NATURAL;
Inline_Tail
: STRING (1 .. 200);
Inlast_Tail
: NATURAL;
Hf_Left
: STRING (1 .. 100);
Hf_Llast
: NATURAL;
Hf_Center
: STRING (1 .. 100);
Hf_Clast
: NATURAL;
Hf_Right
: STRING (1 .. 100);
Hf_Rlast
: NATURAL;
Hf_Line
: Fof.Header_Footer_Line;
type HF_TYPE is
( FOOTER_LINE, HEADER_LINE );
Command_Name
: Command_Symbols.Command_Text;
-- ..................................
-- . .
-- . Process.Parse_Hf . SPEC & BODY
-- . .
-- ..................................
function Parse_Hf
( Line : in STRING;
Kind : in HF_TYPE )
return Fof.Header_Footer_Line is
--| Purpose
--| Parse_Hf accepts a Line of the form /--/--/--/ or #/--/--/--/
--| and places the three parts into Hf_Left, Hf_Center, and Hf_Right.
--| If the # is present, it returns the #; else, it returns the default
--| value for the # based on Kind.
--|
--| Exceptions (none)
--| Notes (none)
Default_Header_Line
: Fof.Header_Footer_Line
:= 1;
Default_Footer_Line
: Fof.Header_Footer_Line
:= 2;
Hf_Line_Number
: Fof.Header_Footer_Line;
Temp
: NATURAL;
Fof_Kind
: Fof.Page_Attribute;
Start
: NATURAL
:= Line'First;
Delimiter
: CHARACTER;
-- ..................................
-- . .
-- . Process.Parse_Hf.Sub_Parse . SPEC & BODY
-- . .
-- ..................................
procedure Sub_Parse
( Item : in out STRING;
Last : out NATURAL ) is
--| Purpose
--| Sub_Parse parses Line starting at Start until Delimiter
--| or Line'Last is encountered. It places the parsed-out
--| string into Item and returns the index of the last character.
--|
--| Exceptions (none)
--| Notes (none)
Item_Index
: NATURAL
:= Item'First - 1;
Stop
: NATURAL
:= Line'Last + 1;
begin -- Sub_Parse
if Start <= Line'Last then
for I in Start .. Line'Last loop
if Line(I) = Delimiter then
Stop := I;
exit;
else
Item_Index := Item_Index + 1;
Item(Item_Index) := Line(I);
end if;
end loop;
Start := Stop + 1;
end if;
while Item_Index >= Item'First loop
-- remove trailing white space
exit when Item(Item_Index) > ' ';
Item_Index := Item_Index - 1;
end loop;
Last := Item_Index;
end Sub_Parse;
begin -- Parse_Hf
case Kind is
when HEADER_LINE =>
Hf_Line_Number := Default_Header_Line;
Fof_Kind := Fof.Header_Lines;
when FOOTER_LINE =>
Hf_Line_Number := Default_Footer_Line;
Fof_Kind := Fof.Footer_Lines;
end case;
if Line'Length > 0 then
if (Line(Start) >= '0') and (Line(Start) <= '9') then
Temp := To_Nat(Line(Start .. Start));
if (Temp > 0)
and (Temp <= Fof.Get_Page_Attribute(Target, Fof_Kind)) then
Hf_Line_Number := Fof.Header_Footer_Line(Temp);
else
Error_Log.Write_Error(Error_Hf_Lines);
end if;
Start := Start + 1;
end if;
Temp := Start;
Start := Line'Last + 1;
for I in Temp .. Line'Last loop
if Line(I) > ' ' then
Start := I;
exit;
end if;
end loop;
if Start <= Line'Last then
Delimiter := Line(Start);
Start := Start + 1;
Sub_Parse(Hf_Left, Hf_Llast);
Sub_Parse(Hf_Center, Hf_Clast);
Sub_Parse(Hf_Right, Hf_Rlast);
end if;
else
Hf_Llast := 0;
Hf_Clast := 0;
Hf_Rlast := 0;
end if;
return Hf_Line_Number;
end Parse_Hf;
-- ..................................
-- . .
-- . Process.Interpret_Write . SPEC & BODY
-- . .
-- ..................................
procedure Interpret_Write
( In_String : in STRING;
Out_String : out STRING;
Out_Last : out NATURAL ) is
--| Purpose
--| Interpret_Write interprets control and escape characters
--| from In_String, placing the result into Out_String.
--| Interpret_Write is only called by the WRITE command
--| processing section of code.
--|
--| Exceptions (none)
--| Notes (none)
O_Index
: NATURAL
:= Out_String'First;
type STATE_TYPE is
( IN_CONTROL, IN_ESCAPE, IN_TEXT );
Current_State
: STATE_TYPE
:= IN_TEXT;
begin -- Interpret_Write
for I in In_String'range loop
case Current_State is
when IN_TEXT =>
case In_String(I) is
when '^' =>
Current_State := IN_CONTROL;
when '\' =>
Current_State := IN_ESCAPE;
when others =>
if O_Index <= Out_String'Last then
Out_String(O_Index) := In_String(I);
O_Index := O_Index + 1;
else
Error_Log.Write_Error(Error_Write);
exit;
end if;
end case;
when IN_CONTROL =>
Temp := CHARACTER'Pos(In_String(I))
- CHARACTER'Pos('@');
if O_Index <= Out_String'Last then
Out_String(O_Index) := CHARACTER'Val(Temp);
O_Index := O_Index + 1;
else
Error_Log.Write_Error(Error_Write);
exit;
end if;
Current_State := IN_TEXT;
when IN_ESCAPE =>
if O_Index <= Out_String'Last then
case In_String(I) is
when 'b' =>
Out_String(O_Index) := Ascii.Bs;
when 'd' =>
Out_String(O_Index) := Ascii.Del;
when 'e' =>
Out_String(O_Index) := Ascii.Esc;
when 'n' =>
Out_String(O_Index) := Ascii.Lf;
when 'r' =>
Out_String(O_Index) := Ascii.Cr;
when 't' =>
Out_String(O_Index) := Ascii.Ht;
when others =>
Out_String(O_Index) := In_String(I);
end case;
O_Index := O_Index + 1;
else
Error_Log.Write_Error(Error_Write);
exit;
end if;
Current_State := IN_TEXT;
end case;
end loop;
Out_Last := O_Index - 1;
end Interpret_Write;
-- ..................................
-- . .
-- . Process.Check_Margins . SPEC & BODY
-- . .
-- ..................................
function Check_Margins
return BOOLEAN is
--| Purpose
--| Check_Margins is a common routine for checking to ensure that
--| the margins are OK before a change is fully put into effect.
--| Return TRUE if margins are OK.
--|
--| Exceptions (none)
--| Notes (none)
Result
: BOOLEAN;
begin -- Check_Margins
Result := (Fof.Get_Page_Attribute(Target, Fof.Left_Margin)
+ Fof.Get_Page_Attribute(Target, Fof.Left_Indent))
< (Fof.Get_Page_Attribute(Target, Fof.Right_Margin)
- Fof.Get_Page_Attribute(Target, Fof.Right_Indent));
if not Result then
Error_Log.Write_Error(Error_Margin);
end if;
return Result;
end Check_Margins;
-- ..................................
-- . .
-- . Process.Add_Line_To_Macro . SPEC & BODY
-- . .
-- ..................................
function Add_Line_To_Macro
return BOOLEAN is
--| Purpose
--| In the environment of Process, Add_Line_To_Macro adds the line
--| Inline(1..Inlast) as the next line in the macro. If this line
--| is itself a macro, then its macro definition is added.
--|
--| Exceptions (none)
--| Notes
--| Variables Process.Inline and Process.Inlast are accessed.
--| Variables Process.Inline_Verb, Process.Inline_Tail,
--| Process.Inlast_Verb, and Process.Inlast_Tail are altered.
Continue
: BOOLEAN
:= true;
begin -- Add_Line_To_Macro
if Inline(1) = Variable.Cc then
-- Dot command
Parse(Inline(2 .. Inlast), Inline_Verb, Inline_Tail, Inlast_Verb,
Inlast_Tail);
if Command.Identify(Inline_Verb(1 .. Inlast_Verb)) = Stop_Macro then
-- End of macro encountered
Continue := false;
else
-- Inside macro
if Command.Identify(Inline_Verb(1 .. Inlast_Verb)) = Unknown then
-- Not a normal command
if Macro.Locate(Inline_Verb(1 .. Inlast_Verb)) = Macro.Ok then
Macro.Open(Inline_Verb(1 .. Inlast_Verb), Mid_Read, Mstatus);
while not Macro.Is_Empty(Mid_Read) loop
Macro.Read(Mid_Read, Inline, Inlast);
Macro.Write(Mid, Inline(1 .. Inlast));
end loop;
Macro.Close(Mid_Read);
else
Error_Log.Write_Error(Error_Macro_Unknown_Command);
end if;
else
-- Normal command
Macro.Write(Mid, Inline(1 .. Inlast));
end if;
end if;
else
-- Not dot command
Macro.Write(Mid, Inline(1 .. Inlast));
end if;
return Continue;
end Add_Line_To_Macro;
-- ..................................
-- . .
-- . Process.Fill_Command_Name . SPEC & BODY
-- . .
-- ..................................
procedure Fill_Command_Name
( What : in STRING ) is
--| Purpose
--| Fill_Command_Name places the string in What into the variable
--| Command_Name, space-filling if necessary.
--|
--| Exceptions (none)
--| Notes
--| Variable Process.Command_Name is altered
Last
: NATURAL;
Index
: NATURAL
:= Command_Name'First;
begin -- Fill_Command_Name
Command_Name := (others => ' ');
if What'Length <= Command_Name'Length then
Last := What'Last;
else
Last := What'First + Command_Name'Length - 1;
end if;
for I in What'First .. Last loop
Command_Name(Index) := What(I);
Index := Index + 1;
end loop;
end Fill_Command_Name;
begin -- Process
case Id is
when Auto_Paragraph =>
Variable.Set_Auto_Paragraph(true);
when Bold =>
if Is_Bolding then
if Line_Tail'Length > 0 then
if Line_Tail(1) = 'o' then
if Line_Tail(2) = 'n' then
Fof.Set_Line_Attribute(Target, Fof.Bold, Fof.On);
else
Fof.Set_Line_Attribute(Target, Fof.Bold, Fof.Off);
end if;
else
Temp := To_Nat(Line_Tail);
if Temp > 0 then
Variable.Set_Bold_Count(Temp);
Fof.Set_Line_Attribute(Target, Fof.Bold, Fof.On);
end if;
end if;
else
Variable.Set_Bold_Count(1);
Fof.Set_Line_Attribute(Target, Fof.Bold, Fof.On);
end if;
end if;
when Break =>
Fof.Break_Line(Target);
when Center =>
Fof.Break_Line(Target);
if Line_Tail'Length > 0 then
if Line_Tail(1) = 'o' then
if Line_Tail(2) = 'n' then
Fof.Set_Line_Attribute(Target, Fof.Center, Fof.On);
else
Fof.Set_Line_Attribute(Target, Fof.Center, Fof.Off);
end if;
else
Temp := To_Nat(Line_Tail);
if Temp > 0 then
Variable.Set_Center_Count(Temp);
Fof.Set_Line_Attribute(Target, Fof.Center, Fof.On);
else
Fof.Set_Line_Attribute(Target, Fof.Center, Fof.Off);
end if;
end if;
else
Variable.Set_Center_Count(1);
Fof.Set_Line_Attribute(Target, Fof.Center, Fof.On);
end if;
when Comment =>
null;
when Console_Message =>
Console.Put_Line(Line_Tail);
when Contents_Select =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
if Temp <= 5 then
Contents.Select_Table(Temp);
else
Error_Log.Write_Warning(Warning_Contents_Number);
Contents.Select_Table(0);
end if;
else
Contents.Select_Table(0);
end if;
when Disable_Bolding =>
Is_Bolding := false;
when Enable_Bolding =>
Is_Bolding := true;
when Enter_Contents =>
Fof.Break_Line(Target);
if Line_Tail'Length > 0 then
if Line_Tail(1) in '0' .. '9' then
Parse(Line_Tail, Inline_Verb, Inline_Tail, Inlast_Verb,
Inlast_Tail);
Last_Contents_Indent := To_Nat(Inline_Verb(1 .. Inlast_Verb));
Contents.Add_Line(Last_Contents_Indent,
Inline_Tail(1 .. Inlast_Tail), Fof.Current_Page(Target));
else
Contents.Add_Line(Last_Contents_Indent, Line_Tail,
Fof.Current_Page(Target));
end if;
else
Contents.Add_Line(0, "", Fof.Current_Page(Target));
end if;
when Environment_Pop =>
Fof.Break_Line(Target);
Environment.Pop(Target, Is_Bolding, Is_Underlining);
when Environment_Push =>
Fof.Break_Line(Target);
Environment.Push(Target, Is_Bolding, Is_Underlining);
when Fill =>
Fof.Break_Line(Target);
Fof.Set_Line_Attribute(Target, Fof.Fill, Fof.On);
when Footer =>
Hf_Line := Parse_Hf(Line_Tail, FOOTER_LINE);
if Hf_Line > 0 then
Fof.Set_Footer_Line(Target, Fof.All_Pages, Hf_Line, Hf_Left(1 ..
Hf_Llast), Hf_Center(1 .. Hf_Clast), Hf_Right(1 .. Hf_Rlast));
else
Error_Log.Write_Error(Error_Hf_Lines);
end if;
when Footer_Even =>
Hf_Line := Parse_Hf(Line_Tail, FOOTER_LINE);
if Hf_Line > 0 then
Fof.Set_Footer_Line(Target, Fof.Even_Pages, Hf_Line, Hf_Left(1 ..
Hf_Llast), Hf_Center(1 .. Hf_Clast), Hf_Right(1 .. Hf_Rlast));
else
Error_Log.Write_Error(Error_Hf_Lines);
end if;
when Footer_Odd =>
Hf_Line := Parse_Hf(Line_Tail, FOOTER_LINE);
if Hf_Line > 0 then
Fof.Set_Footer_Line(Target, Fof.Odd_Pages, Hf_Line, Hf_Left(1 ..
Hf_Llast), Hf_Center(1 .. Hf_Clast), Hf_Right(1 .. Hf_Rlast));
else
Error_Log.Write_Error(Error_Hf_Lines);
end if;
when Header =>
Hf_Line := Parse_Hf(Line_Tail, HEADER_LINE);
if Hf_Line > 0 then
Fof.Set_Header_Line(Target, Fof.All_Pages, Hf_Line, Hf_Left(1 ..
Hf_Llast), Hf_Center(1 .. Hf_Clast), Hf_Right(1 .. Hf_Rlast));
else
Error_Log.Write_Error(Error_Hf_Lines);
end if;
when Header_Even =>
Hf_Line := Parse_Hf(Line_Tail, HEADER_LINE);
if Hf_Line > 0 then
Fof.Set_Header_Line(Target, Fof.Even_Pages, Hf_Line, Hf_Left(1 ..
Hf_Llast), Hf_Center(1 .. Hf_Clast), Hf_Right(1 .. Hf_Rlast));
else
Error_Log.Write_Error(Error_Hf_Lines);
end if;
when Header_Odd =>
Hf_Line := Parse_Hf(Line_Tail, HEADER_LINE);
if Hf_Line > 0 then
Fof.Set_Header_Line(Target, Fof.Odd_Pages, Hf_Line, Hf_Left(1 ..
Hf_Llast), Hf_Center(1 .. Hf_Clast), Hf_Right(1 .. Hf_Rlast));
else
Error_Log.Write_Error(Error_Hf_Lines);
end if;
when Include =>
if Line_Tail'Length > 0 then
if Word_Processor.Process_Source_File(Line_Tail)
= Word_Processor.Not_Ok then
Error_Log.Write_Error(Error_Include & Line_Tail);
end if;
else
Error_Log.Write_Error(Error_Include & Line_Tail);
end if;
when Index_Entry =>
if Line_Tail'Length > 0 then
if not Index_Is_Open then
begin
Temp := Fof.Get_Page_Attribute(Target, Fof.Right_Margin)
- Fof.Get_Page_Attribute(Target, Fof.Left_Margin) + 1;
Temp1 := Fof.Get_Page_Attribute(Target, Fof.Total_Lines)
- (Fof.Get_Page_Attribute(Target, Fof.Header_Lines)
+ Fof.Get_Page_Attribute(Target, Fof.Footer_Lines)
+ Fof.Get_Page_Attribute(Target, Fof.Top_Margin)
+ Fof.Get_Page_Attribute(Target, Fof.Bottom_Margin));
Index.Create(Index_File_Name, Index_Line_Length, Temp, Temp1);
Index_Is_Open := true;
exception
when others =>
Error_Log.Write_Error(Error_Index_File_Create);
end;
end if;
if Index_Is_Open then
begin
Index.Add_Entry(Line_Tail, Fof.Current_Page(Target));
exception
when others =>
null;
end;
end if;
end if;
when Index_Length =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
if Temp > 0 then
Index_Line_Length := Temp;
end if;
end if;
when Justify =>
Fof.Break_Line(Target);
Fof.Set_Line_Attribute(Target, Fof.Justify, Fof.On);
when Left_Indent =>
Fof.Break_Line(Target);
Old_Value := Fof.Get_Page_Attribute(Target, Fof.Left_Indent);
Temp := Adjust(Old_Value, Line_Tail);
Fof.Set_Page_Attribute(Target, Fof.Left_Indent, Temp);
if not Check_Margins then
Fof.Set_Page_Attribute(Target, Fof.Left_Indent, Old_Value);
end if;
when Left_Margin =>
Fof.Break_Line(Target);
Old_Value := Fof.Get_Page_Attribute(Target, Fof.Left_Margin);
Temp := Adjust(Old_Value, Line_Tail);
if Temp = 0 then
Temp := 1;
end if;
Fof.Set_Page_Attribute(Target, Fof.Left_Margin, Temp);
if not Check_Margins then
Fof.Set_Page_Attribute(Target, Fof.Left_Margin, Old_Value);
end if;
when Lex =>
if Line_Tail'Length > 0 then
Parse(Line_Tail, Inline_Verb, Inline_Tail, Inlast_Verb,
Inlast_Tail);
Fill_Command_Name(Inline_Verb(1 .. Inlast_Verb));
Temp := Cl'Last + 1;
for I in Cl'range loop
if Command_Name = Cl(I).Name then
Temp := I;
exit;
end if;
end loop;
if Temp > Cl'Last then
Error_Log.Write_Error(Error_Unknown);
else
Fill_Command_Name(Inline_Tail(1 .. Inlast_Tail));
Cl(Temp).Name := Command_Name;
end if;
else
Error_Log.Write_Error(Error_Lex);
end if;
when Line_Spacing =>
if Line_Tail'Length > 0 then
Temp := Fof.Get_Page_Attribute(Target, Fof.Line_Spacing)
+ 1;
Temp := Adjust(Temp, Line_Tail) - 1;
Fof.Set_Page_Attribute(Target, Fof.Line_Spacing, Temp);
else
Fof.Set_Page_Attribute(Target, Fof.Line_Spacing, Fof.
Page_Attribute_Defaults(Fof.Line_Spacing));
end if;
when Nl_Bottom =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
Fof.Set_Page_Attribute(Target, Fof.Bottom_Margin, Temp);
else
Fof.Set_Page_Attribute(Target, Fof.Bottom_Margin, Default_Bottom);
end if;
when Nl_Footer =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
if Temp > Fof.Maximum_Number_Of_Header_Footer_Lines then
Error_Log.Write_Error(Error_Hf_Lines);
else
Fof.Set_Page_Attribute(Target, Fof.Footer_Lines, Temp);
for I in 1 .. Fof.Header_Footer_Line(Temp) loop
Fof.Set_Footer_Line(Target, Fof.All_Pages, I, "", "", "");
end loop;
end if;
else
Fof.Set_Page_Attribute(Target, Fof.Footer_Lines, Default_Footer);
end if;
when Nl_Header =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
if Temp > Fof.Maximum_Number_Of_Header_Footer_Lines then
Error_Log.Write_Error(Error_Hf_Lines);
else
Fof.Set_Page_Attribute(Target, Fof.Header_Lines, Temp);
for I in 1 .. Fof.Header_Footer_Line(Temp) loop
Fof.Set_Header_Line(Target, Fof.All_Pages, I, "", "", "");
end loop;
end if;
else
Fof.Set_Page_Attribute(Target, Fof.Header_Lines, Default_Header);
end if;
when Nl_Top =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
Fof.Set_Page_Attribute(Target, Fof.Top_Margin, Temp);
else
Fof.Set_Page_Attribute(Target, Fof.Top_Margin, Default_Top);
end if;
when No_Auto_Paragraph =>
Variable.Set_Auto_Paragraph(false);
when No_Fill =>
Fof.Break_Line(Target);
Fof.Set_Line_Attribute(Target, Fof.Fill, Fof.Off);
when No_Justify =>
Fof.Break_Line(Target);
Fof.Set_Line_Attribute(Target, Fof.Justify, Fof.Off);
when No_Paging =>
Fof.Break_Line(Target);
Fof.Set_Line_Attribute(Target, Fof.Paging, Fof.Off);
when Number_Register =>
if Line_Tail'Length > 0 then
Parse(Line_Tail, Inline_Verb, Inline_Tail, Inlast_Verb,
Inlast_Tail);
if Inlast_Verb > 0 then
if Inline_Verb(1) in Variable.Nreg then
Temp := Variable.Nr(Inline_Verb(1));
Variable.Set_Nr(Inline_Verb(1), Adjust(Temp, Inline_Tail(1 ..
Inlast_Tail)));
else
Error_Log.Write_Error(Error_Number_Register & "(reg ID)");
end if;
else
Error_Log.Write_Error(Error_Number_Register & "(argument)");
end if;
else
Error_Log.Write_Error(Error_Number_Register & "(after .nr)");
end if;
when Offset =>
Fof.Break_Line(Target);
if Line_Tail'Length > 0 then
Temp := Fof.Get_Page_Attribute(Target, Fof.Page_Offset);
Temp := Adjust(Temp, Line_Tail);
Fof.Set_Page_Attribute(Target, Fof.Page_Offset, Temp);
else
Fof.Set_Page_Attribute(Target, Fof.Page_Offset, 0);
end if;
when Page =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
if Temp = 0 then
Temp := 1;
end if;
Fof.Break_Page(Target, Fof.Page_Number(Temp));
else
Fof.Break_Page(Target);
end if;
when Page_Number_Format =>
if Line_Tail'Length > 0 then
Parse(Line_Tail, Inline_Verb, Inline_Tail, Inlast_Verb,
Inlast_Tail);
case Inline_Verb(1) is
when 'a' =>
Fof.Set_Page_Number_Format(Target, Fof.Arabic,
Inline_Tail(1..Inlast_Tail));
when 'l' =>
Fof.Set_Page_Number_Format(Target, Fof.Lower_Roman,
Inline_Tail(1..Inlast_Tail));
when 'u' =>
Fof.Set_Page_Number_Format(Target, Fof.Upper_Roman,
Inline_Tail(1..Inlast_Tail));
when others =>
Error_Log.Write_Error(Error_Page_Number_Format);
end case;
else
Fof.Set_Page_Number_Format(Target, Fof.Arabic, "");
end if;
when Page_Size =>
if Line_Tail'Length > 0 then
Temp := Fof.Get_Page_Attribute(Target, Fof.Total_Lines);
Temp := Adjust(Temp, Line_Tail);
Fof.Set_Page_Attribute(Target, Fof.Total_Lines, Temp);
else
Fof.Set_Page_Attribute(Target, Fof.Total_Lines, Fof.
Page_Attribute_Defaults(Fof.Total_Lines));
end if;
when Paging =>
Fof.Break_Line(Target);
Fof.Set_Line_Attribute(Target, Fof.Paging, Fof.On);
when Print_Contents =>
Fof.Break_Line(Target);
if Line_Tail'Length > 0 then
Contents.Print(Target, To_Nat(Line_Tail));
else
Contents.Print(Target, Default_Contents_Indentation);
end if;
when Right_Indent =>
Fof.Break_Line(Target);
Old_Value := Fof.Get_Page_Attribute(Target, Fof.Right_Indent);
Temp := Adjust(Old_Value, Line_Tail);
Fof.Set_Page_Attribute(Target, Fof.Right_Indent, Temp);
if not Check_Margins then
Fof.Set_Page_Attribute(Target, Fof.Right_Indent, Old_Value);
end if;
when Right_Margin =>
Fof.Break_Line(Target);
Old_Value := Fof.Get_Page_Attribute(Target, Fof.Right_Margin);
Temp := Adjust(Old_Value, Line_Tail);
Fof.Set_Page_Attribute(Target, Fof.Right_Margin, Temp);
if not Check_Margins then
Fof.Set_Page_Attribute(Target, Fof.Right_Margin, Old_Value);
end if;
when Set_Cchar =>
if Line_Tail'Length > 0 then
Variable.Set_Cc(Line_Tail(Line_Tail'First));
else
Variable.Set_Cc(Variable.Default_Cc);
end if;
when Set_Echar =>
if Line_Tail'Length > 0 then
Variable.Set_Ec(Line_Tail(Line_Tail'First));
else
Variable.Set_Ec(Variable.Default_Ec);
end if;
when Set_Fchar =>
if Line_Tail'Length > 0 then
Variable.Set_Fc(Line_Tail(Line_Tail'First));
else
Variable.Set_Fc(Variable.Default_Fc);
end if;
when Skip =>
Fof.Break_Line(Target);
if Line_Tail'Length > 0 then
Fof.Skip(Target, Fof.Line_Number(To_Nat(Line_Tail)));
else
Fof.Skip(Target, 1);
end if;
when Space_To =>
Fof.Break_Line(Target);
if Line_Tail'Length > 0 then
case Line_Tail(1) is
when '-' =>
Temp := Fof.Get_Page_Attribute(Target,
Fof.Total_Lines);
Temp := Temp - Fof.Get_Page_Attribute(Target,
Fof.Bottom_Margin);
Temp := Temp - Fof.Get_Page_Attribute(Target,
Fof.Footer_Lines);
Temp := Adjust(Temp, Line_Tail);
when '+' =>
Temp := Fof.Get_Page_Attribute(Target,
Fof.Top_Margin) + 1;
Temp := Temp + Fof.Get_Page_Attribute(Target,
Fof.Header_Lines);
Temp := Adjust(Temp, Line_Tail);
when others =>
Temp := To_Nat(Line_Tail);
end case;
if Temp < NATURAL(Fof.Current_Line(Target)) then
Error_Log.Write_Error(Error_Spaceto);
else
Temp := Temp - NATURAL(Fof.Current_Line(Target));
if Temp > 0 then
Old_Value := Fof.Get_Page_Attribute(Target,
Fof.Line_Spacing);
Fof.Set_Page_Attribute(Target, Fof.Line_Spacing, 0);
Fof.Skip(Target, Fof.Line_Number(Temp));
Fof.Set_Page_Attribute(Target, Fof.Line_Spacing, Old_Value);
end if;
end if;
end if;
when Start_Macro =>
if Line_Tail'Length > 0 then
Macro.Create(Line_Tail, Mid, Mstatus);
if Mstatus = Macro.Ok then
while not Input_File.End_Of_File(Input_File_Id) loop
Input_File.Get_Line(Input_File_Id, Inline, Inlast);
Variable.Increment_Line_Number;
if Inlast > 0 then
exit when not Add_Line_To_Macro;
end if;
end loop;
Macro.Close(Mid);
else
Error_Log.Write_Error(Error_Macro);
end if;
else
Error_Log.Write_Error(Error_Macro);
end if;
when Stop_Macro =>
Error_Log.Write_Error(Error_Macro_End);
when Temporary_Indent =>
Fof.Break_Line(Target);
if Line_Tail'Length > 0 then
Temp := Fof.Get_Page_Attribute(Target, Fof.Left_Margin)
+ Fof.Get_Page_Attribute(Target, Fof.Left_Indent);
Temp := Adjust(Temp, Line_Tail);
if Temp > 0 then
Fof.Set_Page_Attribute(Target, Fof.Temp_Indent, Temp);
else
Error_Log.Write_Error(Error_Indent);
end if;
end if;
when Test_Page =>
if Line_Tail'Length > 0 then
Temp := To_Nat(Line_Tail);
if Temp > 0 then
if not Fof.Test_Page(Target, Fof.Line_Number(Temp)) then
Fof.Break_Page(Target);
end if;
end if;
end if;
when Underline =>
if Is_Underlining then
if Line_Tail'Length > 0 then
if Line_Tail(1) = 'o' then
if Line_Tail(2) = 'n' then
Fof.Set_Line_Attribute(Target, Fof.Underline, Fof.On);
else
Fof.Set_Line_Attribute(Target, Fof.Underline, Fof.Off);
end if;
else
Temp := To_Nat(Line_Tail);
if Temp > 0 then
Variable.Set_Underline_Count(Temp);
Fof.Set_Line_Attribute(Target, Fof.Underline, Fof.On);
end if;
end if;
else
Variable.Set_Underline_Count(1);
Fof.Set_Line_Attribute(Target, Fof.Underline, Fof.On);
end if;
end if;
when Underline_Mode =>
if Line_Tail'Length > 0 then
case Line_Tail(1) is
when 'a' =>
Fof.Set_Line_Attribute(Target, Fof.Underline_Punct, Fof.On);
when others =>
Fof.Set_Line_Attribute(Target, Fof.Underline_Punct, Fof.Off);
end case;
else
Fof.Set_Line_Attribute(Target, Fof.Underline_Punct, Fof.Off);
end if;
when Disable_Underlining =>
Is_Underlining := false;
when Enable_Underlining =>
Is_Underlining := true;
when Variable_Get =>
if Line_Tail'Length > 0 then
Parse(Line_Tail, Inline_Verb, Inline_Tail, Inlast_Verb,
Inlast_Tail);
if Inlast_Tail > 0 then
Console.Put(Inline_Tail(1 .. Inlast_Tail));
else
Console.Put(Inline_Verb(1 .. Inlast_Verb) & "> ");
end if;
Console.Get_Line(Inline_Tail, Inlast_Tail);
Variable.Set_Var(Inline_Verb(1 .. Inlast_Verb), Inline_Tail(1 ..
Inlast_Tail));
else
Error_Log.Write_Error(Error_Variable_Set);
end if;
when Variable_Set =>
if Line_Tail'Length > 0 then
Parse(Line_Tail, Inline_Verb, Inline_Tail, Inlast_Verb,
Inlast_Tail);
Variable.Set_Var(Inline_Verb(1 .. Inlast_Verb), Inline_Tail(1 ..
Inlast_Tail));
else
Error_Log.Write_Error(Error_Variable_Set);
end if;
when Write =>
if Line_Tail'Length > 0 then
Interpret_Write(Line_Tail, Line_To_Write, Ltw_Last);
Fof.Put_Invisible_Word(Target, Line_To_Write(1 .. Ltw_Last));
end if;
when Unknown =>
Error_Log.Write_Error(Error_Unknown);
end case;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Process);
end Process;
-- ..................................
-- . .
-- . Disable_Bolding . BODY
-- . .
-- ..................................
procedure Disable_Bolding is
--| Notes (none)
begin -- Disable_Bolding
Is_Bolding := false;
end Disable_Bolding;
-- ..................................
-- . .
-- . Disable_Underlining . BODY
-- . .
-- ..................................
procedure Disable_Underlining is
--| Notes (none)
begin -- Disable_Underlining
Is_Underlining := false;
end Disable_Underlining;
end Command;
--::::::::::
--cnt_body.a
--::::::::::
-- **********************************
-- * *
-- * Contents * BODY
-- * *
-- **********************************
with Command_Symbols;
with Error_Log;
with Input_File;
with Output_File;
package body Contents is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
Current_Table
: Table_Number
:= 0;
Current_Table_File
: STRING (1 .. 8)
:= "cnt0.cnt";
Current_Number_Position
: constant
:= 4;
type TABLE_TYPE is
record
File_Id : Output_File.File_Type;
Is_Open : BOOLEAN := false;
end record;
type TABLE_ARRAY is
array (Table_Number)
of TABLE_TYPE;
Table
: TABLE_ARRAY;
package Fof
renames Formatted_Output_File;
use Command_Symbols;
-- ..................................
-- . .
-- . Select_Table . BODY
-- . .
-- ..................................
procedure Select_Table
( Which_Table : in Table_Number ) is
--| Notes (none)
begin -- Select_Table
Current_Table := Which_Table;
Current_Table_File(Current_Number_Position)
:= CHARACTER'Val(Current_Table + CHARACTER'Pos('0'));
end Select_Table;
-- ..................................
-- . .
-- . Add_Line . BODY
-- . .
-- ..................................
procedure Add_Line
( Level : in NATURAL;
Line : in STRING;
Page_Number : in STRING ) is
--| Notes (none)
begin -- Add_Line
if not Table(Current_Table).Is_Open then
Output_File.Create(Table(Current_Table).File_Id, Current_Table_File);
Table(Current_Table).Is_Open := true;
end if;
Output_File.Put_Line(Table(Current_Table).File_Id, NATURAL'Image(Level));
Output_File.Put_Line(Table(Current_Table).File_Id, Line);
Output_File.Put_Line(Table(Current_Table).File_Id, Page_Number);
exception -- Add_Line -- Add_Line
when others =>
Error_Log.Write_Error(Error_Internal_Add_Line);
end Add_Line;
-- ..................................
-- . .
-- . Print . BODY
-- . .
-- ..................................
procedure Print
( Target : in Formatted_Output_File.File;
Spaces_Per_Level : in NATURAL ) is
--| Notes (none)
Old_Fill
: Fof.Off_On;
Cline
: STRING (1 .. 200);
Cline_Last
: NATURAL;
Line
: STRING (1 .. 200);
Line_Last
: NATURAL;
Clevel
: NATURAL;
Cpage
: STRING (1 .. 200);
Cpage_Last
: NATURAL;
Start
: NATURAL;
Dummy
: BOOLEAN;
Input_File_Id
: Input_File.File_Type;
-- ..................................
-- . .
-- . Print.Build_Line . SPEC & BODY
-- . .
-- ..................................
procedure Build_Line
( Level : in NATURAL;
Line : in STRING;
Page_Number : in STRING ) is
--| Purpose
--| Build_Line builds the table of contents line into the Cline string,
--| setting Cline_Last to the index of the last character.
--|
--| Exceptions (none)
--| Notes (none)
Left
: NATURAL
:= Spaces_Per_Level * Level + 1;
Right
: NATURAL
:= Fof.Get_Page_Attribute(Target, Fof.Right_Margin)
- Fof.Get_Page_Attribute(Target, Fof.Page_Offset)
- Fof.Get_Page_Attribute(Target, Fof.Left_Margin) + 1;
Start
: NATURAL
:= Left + Line'Length;
begin -- Build_Line
if Line'Length > 0 then
Cline_Last := Left - 1;
Cline(1 .. Right) := (others => ' ');
Cline(Cline_Last + 1 .. Cline_Last + Line'Length) := Line;
if Cline_Last + Line'Length > Right - Page_Number'Length then
Error_Log.Write_Warning(Warning_Contents_Line_Truncation);
end if;
if (Start / 2) * 2 /= Start then
Start := Start + 1;
end if;
Start := Start + 1;
for I in Start .. Right loop
Cline(I) := '.';
end loop;
Cline(Right - Page_Number'Length .. Right) := " " & Page_Number;
Cline_Last := Right;
else
Cline_Last := 0;
end if;
end Build_Line;
begin -- Print
Fof.Break_Line(Target);
Old_Fill := Fof.Get_Line_Attribute(Target, Fof.Fill);
Fof.Set_Line_Attribute(Target, Fof.Fill, Fof.Off);
if Table(Current_Table).Is_Open then
Output_File.Close(Table(Current_Table).File_Id);
Table(Current_Table).Is_Open := false;
Input_File.Open(Input_File_Id, Current_Table_File);
while not Input_File.End_Of_File(Input_File_Id) loop
Input_File.Get_Line(Input_File_Id, Cline, Cline_Last);
Start := Cline_Last + 1;
for I in 1 .. Cline_Last loop
if Cline(I) > ' ' then
Start := I;
exit;
end if;
end loop;
if Start <= Cline_Last then
begin
Clevel := NATURAL'Value(Cline(Start .. Cline_Last));
exception
when others =>
Clevel := 0;
end;
else
Clevel := 0;
end if;
Input_File.Get_Line(Input_File_Id, Line, Line_Last);
Input_File.Get_Line(Input_File_Id, Cpage, Cpage_Last);
Build_Line(Clevel, Line(1 .. Line_Last), Cpage(1 .. Cpage_Last));
Fof.Put_Line(Target, Cline(1 .. Cline_Last));
end loop;
Input_File.Close(Input_File_Id);
Dummy := Output_File.Delete(Current_Table_File);
else
Error_Log.Write_Warning(Warning_Table_Empty);
end if;
Fof.Set_Line_Attribute(Target, Fof.Fill, Old_Fill);
exception -- Print
when others =>
Error_Log.Write_Error(Error_Internal_Print);
end Print;
end Contents;
--::::::::::
--cot_body.a
--::::::::::
-- **********************************
-- * *
-- * Console * BODY
-- * *
-- **********************************
with Text_IO;
package body Console is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
-- ..................................
-- . .
-- . Put . BODY
-- . .
-- ..................................
procedure Put
( Item : in CHARACTER ) is
--| Notes (none)
begin -- Put
Text_IO.Put(Item);
end Put;
-- ..................................
-- . .
-- . Put . BODY
-- . .
-- ..................................
procedure Put
( Item : in STRING ) is
--| Notes (none)
begin -- Put
Text_IO.Put(Item);
end Put;
-- ..................................
-- . .
-- . Put_Line . BODY
-- . .
-- ..................................
procedure Put_Line
( Item : in STRING ) is
--| Notes (none)
begin -- Put_Line
Text_IO.Put_Line(Item);
end Put_Line;
-- ..................................
-- . .
-- . New_Line . BODY
-- . .
-- ..................................
procedure New_Line is
--| Notes (none)
begin -- New_Line
Text_IO.New_Line;
end New_Line;
-- ..................................
-- . .
-- . Get_Line . BODY
-- . .
-- ..................................
procedure Get_Line
( Item : out STRING;
Last : out NATURAL ) is
--| Notes (none)
begin -- Get_Line
Text_IO.Get_Line(Item, Last);
end Get_Line;
end Console;
--::::::::::
--env_body.a
--::::::::::
-- **********************************
-- * *
-- * Environment * BODY
-- * *
-- **********************************
with Command_Symbols;
with Error_Log;
with Variable;
package body Environment is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Add Set_Underlining to Pop/Push
Number_Of_Stack_Elements
: NATURAL
:= 0;
type PAGE_LIST is
array (Formatted_Output_File.Page_Attribute)
of NATURAL;
type LINE_LIST is
array (Formatted_Output_File.Line_Attribute)
of Formatted_Output_File.Off_On;
type STACK_ELEMENT;
type STACK_ELEMENT_POINTER is
access STACK_ELEMENT;
type STACK_ELEMENT is
record
Pages : PAGE_LIST;
Lines : LINE_LIST;
Cc_Val : CHARACTER;
Ec_Val : CHARACTER;
Fc_Val : CHARACTER;
Auto_Paragraph : BOOLEAN;
Bolding : BOOLEAN;
Underlining : BOOLEAN;
Bold_Count : NATURAL;
Center_Count : NATURAL;
Ul_Count : NATURAL;
Next : STACK_ELEMENT_POINTER := null;
Last : STACK_ELEMENT_POINTER := null;
end record;
Current
: STACK_ELEMENT_POINTER
:= null;
package Fof
renames Formatted_Output_File;
use Command_Symbols;
use Formatted_Output_File;
-- ..................................
-- . .
-- . Pop . BODY
-- . .
-- ..................................
procedure Pop
( Item : in Formatted_Output_File.File;
Set_Bolding : in out BOOLEAN;
Set_Underlining : in out BOOLEAN ) is
--| Notes (none)
begin -- Pop
if Number_Of_Stack_Elements = 0 then
Error_Log.Write_Error(Error_Stack_Empty);
else
for I in Fof.Page_Attribute loop
Fof.Set_Page_Attribute(Item, I, Current.Pages(I));
end loop;
for I in Fof.Line_Attribute loop
if I /= Fof.Fill_State_Before_Center then
Fof.Set_Line_Attribute(Item, I, Current.Lines(I));
end if;
end loop;
Variable.Set_Cc(Current.Cc_Val);
Variable.Set_Ec(Current.Ec_Val);
Variable.Set_Fc(Current.Fc_Val);
Variable.Set_Auto_Paragraph(Current.Auto_Paragraph);
Set_Bolding := Current.Bolding;
Set_Underlining := Current.Underlining;
Variable.Set_Bold_Count(Current.Bold_Count);
Variable.Set_Center_Count(Current.Center_Count);
Variable.Set_Underline_Count(Current.Ul_Count);
if Current.Last /= null then
Current := Current.Last;
end if;
Number_Of_Stack_Elements := Number_Of_Stack_Elements - 1;
end if;
end Pop;
-- ..................................
-- . .
-- . Push . BODY
-- . .
-- ..................................
procedure Push
( Item : in Formatted_Output_File.File;
Set_Bolding : in BOOLEAN;
Set_Underlining : in BOOLEAN ) is
--| Notes (none)
Rover
: STACK_ELEMENT_POINTER;
begin -- Push
if Number_Of_Stack_Elements = 0 then
Current := new STACK_ELEMENT;
else
if Current.Next = null then
Current.Next := new STACK_ELEMENT;
Rover := Current.Next;
Rover.Last := Current;
end if;
Current := Current.Next;
end if;
for I in Fof.Page_Attribute loop
Current.Pages(I) := Fof.Get_Page_Attribute(Item, I);
end loop;
for I in Fof.Line_Attribute loop
Current.Lines(I) := Fof.Get_Line_Attribute(Item, I);
end loop;
Current.Cc_Val := Variable.Cc;
Current.Ec_Val := Variable.Ec;
Current.Fc_Val := Variable.Fc;
Current.Auto_Paragraph := Variable.Is_Auto_Paragraph;
Current.Bolding := Set_Bolding;
Current.Underlining := Set_Underlining;
Current.Bold_Count := Variable.Bold_Count;
Current.Center_Count := Variable.Center_Count;
Current.Ul_Count := Variable.Underline_Count;
Number_Of_Stack_Elements := Number_Of_Stack_Elements + 1;
exception -- Push
when others =>
Error_Log.Write_Error(Error_Stack_Overflow);
end Push;
end Environment;
--::::::::::
--err_body.a
--::::::::::
-- **********************************
-- * *
-- * Error_Log * BODY
-- * *
-- **********************************
with Console;
with Output_File;
with Variable;
package body Error_Log is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
Is_Open
: BOOLEAN
:= false;
Error_File
: Output_File.File_Type;
Output_To_Stdio
: BOOLEAN
:= false;
Error_Count
: NATURAL
:= 0;
Warning_Count
: NATURAL
:= 0;
-- ..................................
-- . .
-- . Open . BODY
-- . .
-- ..................................
procedure Open
( File_Name : in STRING ) is
--| Notes (none)
begin -- Open
if File_Name'Length > 0 then
Output_File.Create(Error_File, File_Name);
Is_Open := true;
Output_To_Stdio := false;
else
Is_Open := true;
Output_To_Stdio := true;
end if;
exception -- Open -- Open -- Open
when others =>
Is_Open := true;
Output_To_Stdio := true;
end Open;
-- ..................................
-- . .
-- . Write_Location . SPEC & BODY
-- . .
-- ..................................
procedure Write_Location is
--| Notes (none)
begin -- Write_Location
if Output_To_Stdio then
Console.Put_Line("(" & Variable.Get_File_Name & ":"
& NATURAL'Image(Variable.Line_Number) & ")");
else
Output_File.Put_Line(Error_File, "(" & Variable.Get_File_Name
& ":" & NATURAL'Image(Variable.Line_Number) & ")");
end if;
end Write_Location;
-- ..................................
-- . .
-- . Write_Error . BODY
-- . .
-- ..................................
procedure Write_Error
( Message : in STRING ) is
--| Notes (none)
begin -- Write_Error
if not Is_Open then
Open("");
end if;
if Output_To_Stdio then
Console.Put("Error : " & Message);
else
Output_File.Put(Error_File, "Error : " & Message);
end if;
Write_Location;
Error_Count := Error_Count + 1;
end Write_Error;
-- ..................................
-- . .
-- . Write_Warning . BODY
-- . .
-- ..................................
procedure Write_Warning
( Message : in STRING ) is
--| Notes (none)
begin -- Write_Warning
if not Is_Open then
Open("");
end if;
if Output_To_Stdio then
Console.Put("Warning : " & Message);
else
Output_File.Put(Error_File, "Warning : " & Message);
end if;
Write_Location;
Warning_Count := Warning_Count + 1;
end Write_Warning;
-- ..................................
-- . .
-- . Close . BODY
-- . .
-- ..................................
procedure Close is
--| Notes (none)
begin -- Close
if Is_Open then
if not Output_To_Stdio then
Output_File.Close(Error_File);
end if;
end if;
Console.Put(" ");
if Error_Count = 0 then
Console.Put("No Errors, ");
else
Console.Put(NATURAL'Image(Error_Count) & " Error(s), ");
end if;
if Warning_Count = 0 then
Console.Put("No Warnings");
else
Console.Put(NATURAL'Image(Warning_Count) & " Warning(s)");
end if;
Console.New_Line;
end Close;
end Error_Log;
--::::::::::
--fof_body.a
--::::::::::
-- **********************************
-- * *
-- * Formatted_Output_File * BODY
-- * *
-- **********************************
with Command_Symbols;
with Dyn;
with Error_Log;
with Output_File;
package body Formatted_Output_File is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial version
--| 02/26/90 Rick Conn Remove trailing spaces from @n
subtype HF is
Dyn.Dyn_String;
type HF_SECTION is
( LEFT, CENTER, RIGHT );
type HF_LINES is
array (Header_Footer_Line, HF_SECTION)
of HF;
Header_Footer_Default
: constant HF_LINES
:= (others => (others => Dyn.D_String(" ")));
subtype LINE is -- very long line for
STRING (1 .. Maximum_Line_Length * 5); -- invisible words
pragma Format_Off;
type FILE_OBJECT is
record
Output_Is_Open : BOOLEAN := false; -- has file been opened?
Output_Is_Empty : BOOLEAN; -- has anything been output?
Line_Is_Empty : BOOLEAN; -- is anything in Current_Line?
Page_Attr : Page_Attribute_List; -- left margin, etc.
Line_Attr : Line_Attribute_List; -- fill, etc (misnomer)
Page_Num : Page_Number; -- # of current page
Line_Num : Line_Number; -- # of line now being built
Even_Header : HF_LINES; -- for even pages
Odd_Header : HF_LINES; -- for odd pages
Even_Footer : HF_LINES; -- for even pages
Odd_Footer : HF_LINES; -- for odd pages
Current_Line : LINE; -- line being built
Index : NATURAL; -- index of next char to place
-- into Current_Line
Char_Count : NATURAL; -- number of visible chars
-- in Current_Line
Last_Char : CHARACTER; -- last char in Current_Line
Page_Number_Id : CHARACTER; -- xlates into page number
-- in headers and footers
Pn_Format : Numeric_Format; -- arabic, lower_ & upper_roman
Pn_String : Dyn.Dyn_String; -- text of page number
File_Id : Output_File.File_Type; -- for Text_IO
end record;
pragma Format_On;
use Command_Symbols;
-- ..................................
-- . .
-- . Is_Punctuation . SPEC & BODY
-- . .
-- ..................................
function Is_Punctuation
( Item : in CHARACTER )
return BOOLEAN is
--| Purpose
--| Is_Punctuation returns TRUE if Item is one of the characters in
--| PUNCTUATION_CHARS.
--|
--| Exceptions (none)
--| Notes (none)
Result
: BOOLEAN
:= false;
begin -- Is_Punctuation
case Item is
when '.' | ',' | '!' | '?' | ';' =>
Result := true;
when others =>
Result := false;
end case;
return Result;
end Is_Punctuation;
-- ..................................
-- . .
-- . Simple_Break_Page . SPEC
-- . .
-- ..................................
procedure Simple_Break_Page
( Item : in File );
-- ..................................
-- . .
-- . Pnum_As_String . SPEC & BODY
-- . .
-- ..................................
function Pnum_As_String
( Value : in Page_Number;
Format : in Numeric_Format )
return STRING is
--| Purpose
--| Pnum_As_String outputs a string (with optional leading blanks)
--| which contains the input number's representation in ARABIC,
--| LOWER_ROMAN, or UPPER_ROMAN forms.
--|
--| Exceptions (none)
--|
--| Notes
--| Value should be less than 1000 if output as a Roman numeral.
Result
: STRING (1 .. 20)
:= (others => ' ');
Rover -- Set for leading space
: NATURAL
:= Result'First;
Ones
: NATURAL
:= 0;
Tens
: NATURAL
:= 0;
Hundreds
: NATURAL
:= 0;
-- ..................................
-- . .
-- . Pnum_As_String.Put . SPEC & BODY
-- . .
-- ..................................
procedure Put
( Item : in CHARACTER ) is
--| Purpose
--| Put places a character into the Result buffer, incrementing Rover.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Put
Rover := Rover + 1;
Result(Rover) := Item;
end Put;
-- ..................................
-- . .
-- . Pnum_As_String.Output . SPEC & BODY
-- . .
-- ..................................
procedure Output
( Value : in NATURAL;
Lower : in CHARACTER;
Middle : in CHARACTER;
Upper : in CHARACTER ) is
--| Purpose
--| Output outputs the appropriate Roman characters representing
--| Value into the string Result, incrementing the pointer Rover
--| as it goes. Value must be between 1 and 9, inclusive.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Output
if Value < 4 then
for I in 1 .. Value loop
Put(Lower);
end loop;
elsif Value = 4 then
Put(Lower);
Put(Middle);
elsif (Value >= 5) and (Value < 9) then
Put(Middle);
if Value > 5 then
for I in 1 .. Value - 5 loop
Put(Lower);
end loop;
end if;
else
Put(Lower);
Put(Upper);
end if;
end Output;
-- ..................................
-- . .
-- . Pnum_As_String.Divide . SPEC & BODY
-- . .
-- ..................................
procedure Divide
( Value : in NATURAL ) is
--| Purpose
--| Divide sets the number of Thousands, Hundreds, Tens, and Ones
--| in the passed value for Roman numeral computation.
--|
--| Exceptions (none)
--| Notes (none)
Temp
: NATURAL
:= Value;
begin -- Divide
if Temp >= 100 then
Hundreds := Temp / 100;
Temp := Temp - Hundreds * 100;
end if;
if Temp >= 10 then
Tens := Temp / 10;
Temp := Temp - Tens * 10;
end if;
Ones := Temp;
end Divide;
begin -- Pnum_As_String
case Format is
when Arabic =>
return Page_Number'Image(Value);
when Lower_Roman =>
if NATURAL(Value) >= 1000 then
Put('z');
Put('z');
Put('z');
else
Divide(NATURAL(Value));
if Hundreds > 0 then
Output(Hundreds, 'c', 'd', 'm');
end if;
if Tens > 0 then
Output(Tens, 'x', 'l', 'c');
end if;
if Ones > 0 then
Output(Ones, 'i', 'v', 'x');
end if;
end if;
when Upper_Roman =>
if NATURAL(Value) >= 1000 then
Put('Z');
Put('Z');
Put('Z');
else
Divide(NATURAL(Value));
if Hundreds > 0 then
Output(Hundreds, 'C', 'D', 'M');
end if;
if Tens > 0 then
Output(Tens, 'X', 'L', 'C');
end if;
if Ones > 0 then
Output(Ones, 'I', 'V', 'X');
end if;
end if;
end case;
return Result(1 .. Rover);
exception
when others =>
Error_Log.Write_Error(Error_Internal_Pnum);
return " ";
end Pnum_As_String;
-- ..................................
-- . .
-- . Start_Line . SPEC & BODY
-- . .
-- ..................................
procedure Start_Line
( Item : in File ) is
--| Purpose
--| This is an internal routine not specified in the package
--| specification. It is used to initialize the Current_Line
--| field of the Item object and the associated fields. It sets
--| the left margin.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Start_Line
if Item.Page_Attr(Temp_Indent) > 0 then
Item.Index := Item.Page_Attr(Temp_Indent)
+ Item.Page_Attr(Page_Offset);
Item.Page_Attr(Temp_Indent) := 0;
else
Item.Index := Item.Page_Attr(Left_Margin)
+ Item.Page_Attr(Left_Indent) + Item.Page_Attr(Page_Offset);
end if;
if Item.Index < 1 then
Item.Index := 1;
end if;
Item.Char_Count := Item.Index - 1;
Item.Current_Line(1 .. Item.Index) := (others => ' ');
Item.Last_Char := ' ';
Item.Line_Is_Empty := false;
end Start_Line;
-- ..................................
-- . .
-- . Space_Lines . SPEC & BODY
-- . .
-- ..................................
procedure Space_Lines
( Item : in File ) is
--| Purpose
--| This is an internal routine not specified in the package
--| specification. It is used to output additional blank lines
--| based on the LINE_SPACING setting.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Space_Lines
if Item.Page_Attr(Line_Spacing) > 0 then
if Test_Page(Item, Line_Number(Item.Page_Attr(Line_Spacing))) then
for I in 1 .. Item.Page_Attr(Line_Spacing) loop
Output_File.New_Line(Item.File_Id);
Item.Line_Num := Item.Line_Num + 1;
end loop;
else
Simple_Break_Page(Item);
end if;
end if;
end Space_Lines;
-- ..................................
-- . .
-- . Justify_Line . SPEC & BODY
-- . .
-- ..................................
procedure Justify_Line
( Item : in File ) is
--| Notes
--| This is an internal routine not specified in the package
--| specification. It is used to fill the Current_Line
--| with spaces so that the last character is on the right
--| margin.
--|
--| Exceptions (none)
--| Notes (none)
Spaces_Required
: constant NATURAL
:= Item.Page_Attr(Right_Margin) - Item.Page_Attr(Right_Indent)
- Item.Char_Count + Item.Page_Attr(Page_Offset);
Spaces_Left
: NATURAL
:= Spaces_Required;
-- ..................................
-- . .
-- . Justify_Line.Justify . SPEC & BODY
-- . .
-- ..................................
function Justify
( Amount_Left : in NATURAL )
return NATURAL is
--| Purpose
--| Justify replaces single spaces in Item.Current_Line with
--| double spaces until Amount is zero or the end of the
--| line is reached.
--|
--| Exceptions (none)
--| Notes (none)
type PARSE_STATE is
( BEFORE_TEXT, IN_TEXT, IN_SPACES, DONE );
State
: PARSE_STATE
:= BEFORE_TEXT;
I -- index for Temp
: NATURAL;
Amount -- number of spaces to go
: NATURAL
:= Amount_Left;
Temp
: LINE;
Was_In_Spaces
: BOOLEAN
:= false;
begin -- Justify
I := 1;
for J in 1 .. Item.Index - 1 loop
case State is
when BEFORE_TEXT =>
Temp(I) := Item.Current_Line(J);
I := I + 1;
if Item.Current_Line(J) > ' ' then
State := IN_TEXT;
end if;
when IN_TEXT =>
if Item.Current_Line(J) = ' ' then
Temp(I) := ' ';
I := I + 1;
Temp(I) := ' ';
I := I + 1;
Amount := Amount - 1;
Was_In_Spaces := true;
if Amount = 0 then
State := DONE;
else
State := IN_SPACES;
end if;
else
Temp(I) := Item.Current_Line(J);
I := I + 1;
end if;
when IN_SPACES =>
Temp(I) := Item.Current_Line(J);
I := I + 1;
if Item.Current_Line(J) /= ' ' then
State := IN_TEXT;
end if;
when DONE =>
Temp(I) := Item.Current_Line(J);
I := I + 1;
end case;
end loop;
Item.Current_Line := Temp;
Item.Index := I;
if not Was_In_Spaces then
Amount := 0;
end if;
return Amount;
end Justify;
begin -- Justify_Line
while Spaces_Left > 0 loop
Spaces_Left := Justify(Spaces_Left);
end loop;
end Justify_Line;
-- ..................................
-- . .
-- . Conditional_Break_Page . SPEC & BODY
-- . .
-- ..................................
procedure Conditional_Break_Page
( Item : in File ) is
--| Purpose
--| Checks to see if there are any lines left on the page and
--| calls Break_Page if not.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Conditional_Break_Page
if INTEGER(Item.Line_Num) > Item.Page_Attr(Total_Lines)
- (Item.Page_Attr(Bottom_Margin) + Item.Page_Attr(Footer_Lines)) then
Simple_Break_Page(Item);
end if;
end Conditional_Break_Page;
-- ..................................
-- . .
-- . Put_Header_Footer_Line . SPEC & BODY
-- . .
-- ..................................
procedure Put_Header_Footer_Line
( Item : in File;
Left_Text : in STRING;
Center_Text : in STRING;
Right_Text : in STRING;
Page_Num : in STRING ) is
--| Purpose
--| This is an internal routine not specified in the package
--| specification. It outputs a header or a footer line, placing
--| the Page_Num string (which MUST be created by Current_Page) into
--| it wherever the Item.Page_Number_Id character is found. The
--| Left_Text string is left-justified against the left margin
--| (first character starts on the left margin), the Center_Text
--| string is centered between the left and right margins, and
--| the Right_Text string is right-justified against the right
--| margin (the last character falls on the right margin).
--|
--| Exceptions (none)
--| Notes (none)
Hf_Line
: LINE
:= (others => ' ');
Hf_Last
: NATURAL
:= Item.Page_Attr(Right_Margin) + Item.Page_Attr(Page_Offset);
Hf_Last_Save
: NATURAL;
Left_Text_Lower
: constant NATURAL
:= Item.Page_Attr(Left_Margin) + Item.Page_Attr(Page_Offset);
Left_Text_Upper
: NATURAL;
Right_Text_Lower
: NATURAL;
Right_Text_Upper
: constant NATURAL
:= Item.Page_Attr(Right_Margin) + Item.Page_Attr(Page_Offset);
Center_Point
: constant NATURAL
:= (Right_Text_Upper - Left_Text_Lower) / 2 + Left_Text_Lower;
Center_Text_Lower
: NATURAL;
Center_Text_Upper
: NATURAL;
Temp_String
: LINE;
Temp_Length
: NATURAL;
-- ..............................................
-- . .
-- . Put_Header_Footer_Line.Build_Temp_String . SPEC & BODY
-- . .
-- ..............................................
procedure Build_Temp_String
( Str : in STRING ) is
--| Purpose
--| Build_Temp_String analyzes the input string for the Page_Number_Id
--| character, building a new output string in the global Temp_String
--| vector which contains the input string with the literal page
--| number substituted for the Page_Number_Id character.
--|
--| Exceptions (none)
--| Notes (none)
J
: NATURAL
:= 1;
begin -- Build_Temp_String
for I in Str'First .. Str'Last loop
if Str(I) = Item.Page_Number_Id then
for K in Page_Num'Range loop
Temp_String(J) := Page_Num(K);
J := J + 1;
end loop;
else
Temp_String(J) := Str(I);
J := J + 1;
end if;
end loop;
Temp_Length := J - 1;
J := 0;
-- remove trailing spaces
for I in reverse 1 .. Temp_Length loop
if Temp_String(I) > ' ' then
J := I;
exit;
end if;
end loop;
Temp_Length := J;
Left_Text_Upper := Item.Page_Attr(Left_Margin) + Temp_Length - 1
+ Item.Page_Attr(Page_Offset);
Right_Text_Lower := Item.Page_Attr(Right_Margin) - Temp_Length + 1
+ Item.Page_Attr(Page_Offset);
Center_Text_Lower := Center_Point - Temp_Length / 2;
Center_Text_Upper := Center_Text_Lower + Temp_Length - 1;
end Build_Temp_String;
begin -- Put_Header_Footer_Line
if Left_Text'Length > 0 then
Build_Temp_String(Left_Text);
if Temp_Length < Right_Text_Upper - Left_Text_Lower + 1 then
Hf_Line(Left_Text_Lower .. Left_Text_Upper) := Temp_String(1 ..
Temp_Length);
else
Hf_Line(Left_Text_Lower .. Right_Text_Upper) := Temp_String(1 ..
(Right_Text_Upper - Left_Text_Lower + 1));
end if;
end if;
if Right_Text'Length > 0 then
Build_Temp_String(Right_Text);
if Temp_Length < Right_Text_Upper - Left_Text_Lower + 1 then
Hf_Line(Right_Text_Lower .. Right_Text_Upper) := Temp_String(1 ..
Temp_Length);
else
Hf_Line(Left_Text_Lower .. Right_Text_Upper) := Temp_String(1 ..
(Right_Text_Upper - Left_Text_Lower + 1));
end if;
end if;
if Center_Text'Length > 0 then
Build_Temp_String(Center_Text);
if Temp_Length < Right_Text_Upper - Left_Text_Lower + 1 then
Hf_Line(Center_Text_Lower .. Center_Text_Upper) := Temp_String(1 ..
Temp_Length);
else
Hf_Line(Left_Text_Lower .. Right_Text_Upper) := Temp_String(1 ..
(Right_Text_Upper - Left_Text_Lower + 1));
end if;
end if;
Hf_Last_Save := Hf_Last;
Hf_Last := 1;
for I in reverse 1 .. Hf_Last_Save loop
if Hf_Line(I) /= ' ' then
Hf_Last := I;
exit;
end if;
end loop;
Output_File.Put_Line(Item.File_Id, Hf_Line(1 .. Hf_Last));
Item.Line_Num := Item.Line_Num + 1;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Hf_Line);
end Put_Header_Footer_Line;
-- ..................................
-- . .
-- . Output_Top_Of_Page . SPEC & BODY
-- . .
-- ..................................
procedure Output_Top_Of_Page
( Item : in File ) is
--| Purpose
--| This is an internal routine not specified in the package
--| specification. Assuming that the output is at the top
--| of page, it increments the Item.Page_Num, outputs
--| the appropriate number of blank lines as per the Top_Margin,
--| and outputs the header lines (distinguishing between even and
--| odd pages).
--|
--| Exceptions (none)
--| Notes (none)
Is_Even
: BOOLEAN;
begin -- Output_Top_Of_Page
Item.Line_Num := 1;
if Item.Page_Attr(Top_Margin) > 0 then
for I in 1 .. Item.Page_Attr(Top_Margin) loop
Output_File.New_Line(Item.File_Id);
Item.Line_Num := Item.Line_Num + 1;
end loop;
end if;
if Item.Page_Attr(Header_Lines) > 0 then
if Item.Page_Num / 2 * 2 = Item.Page_Num then
Is_Even := true;
else
Is_Even := false;
end if;
for I in 1 .. Header_Footer_Line(Item.Page_Attr(Header_Lines)) loop
if Is_Even then
Put_Header_Footer_Line(Item, Dyn.Str(Item.Even_Header(I, LEFT)),
Dyn.Str(Item.Even_Header(I, CENTER)),
Dyn.Str(Item.Even_Header(I, RIGHT)),
Current_Page(Item));
else
Put_Header_Footer_Line(Item, Dyn.Str(Item.Odd_Header(I, LEFT)),
Dyn.Str(Item.Odd_Header(I, CENTER)),
Dyn.Str(Item.Odd_Header(I, RIGHT)),
Current_Page(Item));
end if;
end loop;
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Top);
end Output_Top_Of_Page;
-- ..................................
-- . .
-- . Output_Bottom_Of_Page . BODY
-- . .
-- ..................................
procedure Output_Bottom_Of_Page
( Item : in File ) is
--| Purpose
--| Output_Bottom_Of_Page determines how many blank lines are left
--| in the text area (between the top margin/header combination and
--| the bottom margin/footer combination) and outputs blank lines in
--| order to reach the first footer line. It then outputs the
--| footer (distinguishing between even and odd page footers) and
--| advances over the bottom margin (with either blank lines or
--| form feeds).
--|
--| Exceptions (none)
--| Notes (none)
Lines_Left
: Line_Number;
Is_Even
: BOOLEAN;
begin -- Output_Bottom_Of_Page
Lines_Left := Line_Number(Item.Page_Attr(Total_Lines)
- (Item.Page_Attr(Bottom_Margin) + Item.Page_Attr(Footer_Lines)))
- Item.Line_Num + 1;
if Lines_Left < 0 then
Lines_Left := 0;
end if;
if Lines_Left > 0 then
for I in 1 .. Lines_Left loop
Output_File.New_Line(Item.File_Id);
Item.Line_Num := Item.Line_Num + 1;
end loop;
end if;
if Item.Page_Attr(Footer_Lines) > 0 then
if Item.Page_Num / 2 * 2 = Item.Page_Num then
Is_Even := true;
else
Is_Even := false;
end if;
for I in 1 .. Header_Footer_Line(Item.Page_Attr(Footer_Lines)) loop
if Is_Even then
Put_Header_Footer_Line(Item, Dyn.Str(Item.Even_Footer(I, LEFT)),
Dyn.Str(Item.Even_Footer(I, CENTER)),
Dyn.Str(Item.Even_Footer(I, RIGHT)),
Current_Page(Item));
else
Put_Header_Footer_Line(Item, Dyn.Str(Item.Odd_Footer(I, LEFT)),
Dyn.Str(Item.Odd_Footer(I, CENTER)),
Dyn.Str(Item.Odd_Footer(I, RIGHT)),
Current_Page(Item));
end if;
end loop;
end if;
if Item.Page_Attr(Bottom_Margin) > 0 then
if Item.Line_Attr(Use_Form_Feed) = On then
Output_File.New_Page(Item.File_Id);
else
for I in 1 .. Item.Page_Attr(Bottom_Margin) loop
Output_File.New_Line(Item.File_Id);
Item.Line_Num := Item.Line_Num + 1;
end loop;
end if;
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Bottom);
end Output_Bottom_Of_Page;
-- ..................................
-- . .
-- . Simple_Break_Page . BODY
-- . .
-- ..................................
procedure Simple_Break_Page
( Item : in File ) is
--| Purpose
--| Simple_Break_Page outputs to the bottom of the page and the
--| top of the next page if paging is on.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Simple_Break_Page
if Item.Line_Attr(Paging) = On then
Output_Bottom_Of_Page(Item);
Item.Page_Num := Item.Page_Num + 1;
Output_Top_Of_Page(Item);
else
Item.Line_Num := 1;
end if;
end Simple_Break_Page;
-- ..................................
-- . .
-- . Simple_Break_Page . SPEC & BODY
-- . .
-- ..................................
procedure Simple_Break_Page
( Item : in File;
New_Page_Num : in Page_Number ) is
--| Purpose
--| Simple_Break_Page outputs to the bottom of the page and the
--| top of the next page if paging is on. It sets the number of
--| the new page to New_Page_Num.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Simple_Break_Page
if Item.Line_Attr(Paging) = On then
Output_Bottom_Of_Page(Item);
Item.Page_Num := New_Page_Num;
Output_Top_Of_Page(Item);
else
Item.Page_Num := New_Page_Num;
Item.Line_Num := 1;
end if;
end Simple_Break_Page;
-- ..................................
-- . .
-- . Open . BODY
-- . .
-- ..................................
procedure Open
( Item : in out File;
File_Name : in STRING;
Result : out Status ) is
--| Notes
--| Open the output file object and set
--| defaults. Map the Output_File.Open status to the
--| Formatted_Output_File.Open status.
Local_Result
: Status;
begin -- Open
Item := new FILE_OBJECT;
begin
Output_File.Create(Item.File_Id, File_Name);
Local_Result := Ok;
exception
when others =>
Local_Result := Not_Ok;
end;
if Local_Result = Ok then
Item.Output_Is_Open := true;
Item.Output_Is_Empty := true;
Item.Line_Is_Empty := true;
Item.Page_Attr := Page_Attribute_Defaults;
Item.Line_Attr := Line_Attribute_Defaults;
Item.Page_Num := 0;
Item.Line_Num := 1;
Item.Even_Header := Header_Footer_Default;
Item.Odd_Header := Header_Footer_Default;
Item.Even_Footer := Header_Footer_Default;
Item.Odd_Footer := Header_Footer_Default;
Item.Page_Number_Id := Page_Number_Id_Default;
Item.Pn_Format := Arabic;
Item.Pn_String := Dyn.D_String(Page_Number_Id_Default);
else
Item.Output_Is_Open := false;
end if;
Result := Local_Result;
end Open;
-- ..................................
-- . .
-- . Close . BODY
-- . .
-- ..................................
procedure Close
( Item : in File ) is
--| Notes (none)
begin -- Close
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
if Item.Line_Attr(Paging) = On then
Break_Line(Item);
Output_Bottom_Of_Page(Item);
else
Item.Line_Num := 1;
end if;
Output_File.Close(Item.File_Id);
Item.Output_Is_Open := false;
end Close;
-- ..................................
-- . .
-- . Put_Invisible_Word . BODY
-- . .
-- ..................................
procedure Put_Invisible_Word
( Item : in File;
What : in STRING ) is
--| Notes (none)
begin -- Put_Invisible_Word
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
if Item.Output_Is_Empty then
if Item.Line_Attr(Paging) = On then
Item.Page_Num := Item.Page_Num + 1;
Output_Top_Of_Page(Item);
else
Item.Line_Num := 1;
end if;
Item.Output_Is_Empty := false;
end if;
if Item.Line_Is_Empty then
Start_Line(Item);
end if;
Item.Current_Line(Item.Index .. Item.Index + What'Length - 1) := What;
Item.Index := Item.Index + What'Length;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Put_Invisible);
end Put_Invisible_Word;
-- ..................................
-- . .
-- . Put_Word . BODY
-- . .
-- ..................................
procedure Put_Word
( Item : in File;
What : in STRING ) is
--| Notes (none)
Adjustment_Length
: NATURAL;
Adjustment_String
: constant STRING -- 2 spaces
:= " ";
-- ..................................
-- . .
-- . Put_Word.Put_What . SPEC & BODY
-- . .
-- ..................................
procedure Put_What is
--| Notes
--| Put_What is used to place the What string into Item.Current_Line
--| and update the other variables as necessary.
Full_Adjustment_Length
: NATURAL
:= Adjustment_Length + What'Length;
Full_String_Length
: NATURAL
:= Item.Char_Count + Full_Adjustment_Length;
Lower_Index
: NATURAL
:= Item.Index;
Upper_Index
: NATURAL
:= Item.Index + Full_Adjustment_Length - 1;
begin -- Put_What
Item.Current_Line(Lower_Index .. Upper_Index) := Adjustment_String(1 ..
Adjustment_Length) & What;
Item.Index := Upper_Index + 1;
Item.Char_Count := Full_String_Length;
Item.Last_Char := Item.Current_Line(Item.Index - 1);
if Item.Line_Attr(Underline) = On then
for I in 1 .. What'Length loop
Item.Current_Line(Item.Index) := Ascii.Bs;
Item.Index := Item.Index + 1;
end loop;
for I in What'range loop
if Item.Line_Attr(Underline_Punct) = Off then
if Is_Punctuation(What(I)) then
Item.Current_Line(Item.Index) := What(I);
else
Item.Current_Line(Item.Index) := '_';
end if;
else
Item.Current_Line(Item.Index) := '_';
end if;
Item.Index := Item.Index + 1;
end loop;
end if;
if Item.Line_Attr(Bold) = On then
for I in 1 .. What'Length loop
Item.Current_Line(Item.Index) := Ascii.Bs;
Item.Index := Item.Index + 1;
end loop;
for I in What'range loop
Item.Current_Line(Item.Index) := What(I);
Item.Index := Item.Index + 1;
end loop;
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Put_What);
end Put_What;
begin -- Put_Word
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
if Item.Output_Is_Empty then
if Item.Line_Attr(Paging) = On then
Item.Page_Num := Item.Page_Num + 1;
Output_Top_Of_Page(Item);
else
Item.Line_Num := 1;
end if;
Item.Output_Is_Empty := false;
end if;
if Item.Line_Is_Empty then
Adjustment_Length := 0;
else
case Item.Last_Char is
when ' ' =>
Adjustment_Length := 0;
when '.' =>
Adjustment_Length := 2;
when others =>
Adjustment_Length := 1;
end case;
end if;
if Item.Line_Attr(Fill) = On then
if Item.Char_Count + Adjustment_Length + What'Length
<= Item.Page_Attr(Right_Margin) - Item.Page_Attr(Right_Indent)
+ Item.Page_Attr(Page_Offset) then
-- FILL is on and there is enough room on the line
if Item.Line_Is_Empty then
Start_Line(Item);
end if;
Put_What;
else
-- FILL is on, but not enough room on line
if Item.Line_Attr(Justify) = On and not Item.Line_Is_Empty then
Justify_Line(Item);
end if;
Break_Line(Item);
Start_Line(Item);
Adjustment_Length := 0;
Put_What;
end if;
else
-- No FILL, so no JUSTIFY either
if Item.Line_Is_Empty then
Start_Line(Item);
end if;
Put_What;
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Put_Word);
end Put_Word;
-- ..................................
-- . .
-- . Put_Line . BODY
-- . .
-- ..................................
procedure Put_Line
( Item : in File;
What : in STRING ) is
--| Notes (none)
First
: NATURAL;
Last
: NATURAL;
Temp
: NATURAL;
type PARSE_STATE is
( IN_WHITE_SPACE, IN_TEXT );
Current_State
: PARSE_STATE;
begin -- Put_Line
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
if Item.Output_Is_Empty then
if Item.Line_Attr(Paging) = On then
Item.Page_Num := Item.Page_Num + 1;
Output_Top_Of_Page(Item);
else
Item.Line_Num := 1;
end if;
Item.Output_Is_Empty := false;
end if;
if Item.Line_Attr(Fill) = Off then
-- No FILL, so break previous line and output as a line
Break_Line(Item);
Conditional_Break_Page(Item);
Start_Line(Item); -- for margin settings
Item.Line_Is_Empty := true;
if Item.Line_Attr(CENTER) = On then
Temp := (Item.Page_Attr(Right_Margin)
- Item.Page_Attr(Right_Indent)) - (Item.Page_Attr(Left_Margin)
+ Item.Page_Attr(Left_Indent)) + 1;
if Temp > What'Length then
Temp := (Temp - What'Length) / 2;
for I in 1 .. Temp loop
Output_File.Put(Item.File_Id, ' ');
end loop;
end if;
end if;
Output_File.Put(Item.File_Id, Item.Current_Line(1 .. Item.Char_Count)
& What);
if Item.Line_Attr(Bold) = On then
for I in 1 .. What'Length loop
Output_File.Put(Item.File_Id, Ascii.Bs);
end loop;
for I in What'range loop
Output_File.Put(Item.File_Id, What(I));
end loop;
end if;
if Item.Line_Attr(Underline) = On then
for I in 1 .. What'Length loop
Output_File.Put(Item.File_Id, Ascii.Bs);
end loop;
for I in What'range loop
if What(I) > ' ' then
if Item.Line_Attr(Underline_Punct) = Off then
if Is_Punctuation(What(I)) then
Output_File.Put(Item.File_Id, What(I));
else
Output_File.Put(Item.File_Id, '_');
end if;
else
Output_File.Put(Item.File_Id, '_');
end if;
else
Output_File.Put(Item.File_Id, What(I));
end if;
end loop;
end if;
Output_File.New_Line(Item.File_Id);
Item.Line_Num := Item.Line_Num + 1;
Space_Lines(Item);
else
-- FILL, so parse out each word and use Put_Word to output
Current_State := IN_WHITE_SPACE;
for I in What'First .. What'Last loop
case Current_State is
when IN_WHITE_SPACE =>
if What(I) > ' ' then
First := I;
Current_State := IN_TEXT;
end if;
when IN_TEXT =>
if What(I) <= ' ' then
Last := I - 1;
Put_Word(Item, What(First .. Last));
Current_State := IN_WHITE_SPACE;
end if;
end case;
end loop;
if Current_State = IN_TEXT then
Last := What'Last;
Put_Word(Item, What(First .. Last));
end if;
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Put_Line);
end Put_Line;
-- ..................................
-- . .
-- . Break_Line . BODY
-- . .
-- ..................................
procedure Break_Line
( Item : in File ) is
--| Notes
--| Break_Line checks to see if the Current_Line is empty, and,
--| if not, outputs it and sets the empty flag to TRUE. Page
--| breaks are also handled if necessary.
begin -- Break_Line
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
if not Item.Line_Is_Empty then
Conditional_Break_Page(Item);
Output_File.Put_Line(Item.File_Id, Item.Current_Line(1 .. Item.Index
- 1));
Item.Line_Num := Item.Line_Num + 1;
Space_Lines(Item);
Item.Line_Is_Empty := true;
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Break_Line);
end Break_Line;
-- ..................................
-- . .
-- . Current_Line . BODY
-- . .
-- ..................................
function Current_Line
( Item : in File )
return Line_Number is
--| Notes (none)
begin -- Current_Line
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
return Item.Line_Num;
end Current_Line;
-- ..................................
-- . .
-- . Skip . BODY
-- . .
-- ..................................
procedure Skip
( Item : in File;
Number_Of_Lines : in Line_Number := 1 ) is
--| Notes (none)
begin -- Skip
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
if Item.Output_Is_Empty then
if Item.Line_Attr(Paging) = On then
Item.Page_Num := Item.Page_Num + 1;
Output_Top_Of_Page(Item);
else
Item.Line_Num := 1;
end if;
Item.Output_Is_Empty := false;
end if;
Break_Line(Item);
if Test_Page(Item, Number_Of_Lines + Number_Of_Lines
* Line_Number(Item.Page_Attr(Line_Spacing))) then
for I in 1 .. Number_Of_Lines loop
Output_File.New_Line(Item.File_Id);
Item.Line_Num := Item.Line_Num + 1;
Space_Lines(Item);
end loop;
else
Simple_Break_Page(Item);
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Skip);
end Skip;
-- ..................................
-- . .
-- . Break_Page . BODY
-- . .
-- ..................................
procedure Break_Page
( Item : in File ) is
--| Notes
--| Issues blank lines for the rest of the text area, outputs footer
--| and bottom margin, and outputs header for next page.
begin -- Break_Page
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
Break_Line(Item);
Simple_Break_Page(Item);
exception
when others =>
Error_Log.Write_Error(Error_Internal_Break_Page_1);
end Break_Page;
-- ..................................
-- . .
-- . Break_Page . BODY
-- . .
-- ..................................
procedure Break_Page
( Item : in File;
New_Page_Num : in Page_Number ) is
--| Notes (none)
begin -- Break_Page
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
Break_Line(Item);
Simple_Break_Page(Item, New_Page_Num);
exception
when others =>
Error_Log.Write_Error(Error_Internal_Break_Page_2);
end Break_Page;
-- ..................................
-- . .
-- . Current_Page . BODY
-- . .
-- ..................................
function Current_Page
( Item : in File )
return Page_Number is
--| Notes (none)
begin -- Current_Page
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
return Item.Page_Num;
end Current_Page;
-- ..................................
-- . .
-- . Current_Page . BODY
-- . .
-- ..................................
function Current_Page
( Item : in FILE )
return STRING is
--| Notes (none)
-- ..................................
-- . .
-- . Current_Page.Convert . SPEC & BODY
-- . .
-- ..................................
function Convert
( Page_Number : in STRING )
return STRING is
Result : STRING(1..80);
Last : NATURAL := 0;
-- ..................................
-- . .
-- . Current_Page.Convert.Enter . SPEC & BODY
-- . .
-- ..................................
procedure Enter
( Item : in STRING ) is
Start : NATURAL := Item'First;
begin -- Enter
if Item(Start) = ' ' then
Start := Start + 1;
end if;
for I in Start .. Item'Last loop
Last := Last + 1;
Result(Last) := Item(I);
end loop;
end Enter;
begin -- Convert
for I in Page_Number'Range loop
if Page_Number(I) /= Item.Page_Number_Id then
Last := Last + 1;
Result(Last) := Page_Number(I);
else
Enter(Pnum_As_String(Item.Page_Num, Item.Pn_Format));
end if;
end loop;
return Result(1..Last);
end Convert;
begin -- Current_Page
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
return Convert(Dyn.Str(Item.Pn_String));
end Current_Page;
-- ..................................
-- . .
-- . Set_Page_Number_Format . BODY
-- . .
-- ..................................
procedure Set_Page_Number_Format
( Item : in File;
To : in NUMERIC_FORMAT;
Format_String : in STRING ) is
--| Notes (none)
begin -- Set_Page_Number_Format
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
Item.Pn_Format := To;
if Format_String'Length > 0 then
Dyn.Clear(Item.Pn_String);
Item.Pn_String := Dyn.D_String(Format_String);
end if;
end Set_Page_Number_Format;
-- ..................................
-- . .
-- . Set_Page_Attribute . BODY
-- . .
-- ..................................
procedure Set_Page_Attribute
( Item : in File;
What : in Page_Attribute;
To : in NATURAL ) is
--| Notes (none)
begin -- Set_Page_Attribute
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
Item.Page_Attr(What) := To;
end Set_Page_Attribute;
-- ..................................
-- . .
-- . Set_Line_Attribute . BODY
-- . .
-- ..................................
procedure Set_Line_Attribute
( Item : in File;
What : in Line_Attribute;
To : in Off_On ) is
--| Notes (none)
begin -- Set_Line_Attribute
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
Item.Line_Attr(What) := To;
if What = CENTER then
if To = On then
Item.Line_Attr(Fill_State_Before_Center) := Item.Line_Attr(Fill);
Item.Line_Attr(Fill) := Off;
else
Item.Line_Attr(Fill) := Item.Line_Attr(Fill_State_Before_Center);
end if;
end if;
end Set_Line_Attribute;
-- ..................................
-- . .
-- . Get_Page_Attribute . BODY
-- . .
-- ..................................
function Get_Page_Attribute
( Item : in File;
What : in Page_Attribute )
return NATURAL is
--| Notes (none)
begin -- Get_Page_Attribute
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
return Item.Page_Attr(What);
end Get_Page_Attribute;
-- ..................................
-- . .
-- . Get_Line_Attribute . BODY
-- . .
-- ..................................
function Get_Line_Attribute
( Item : in File;
What : in Line_Attribute )
return Off_On is
--| Notes (none)
begin -- Get_Line_Attribute
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
return Item.Line_Attr(What);
end Get_Line_Attribute;
-- ..................................
-- . .
-- . Test_Page . BODY
-- . .
-- ..................................
function Test_Page
( Item : in File;
Number_Of_Lines : in Line_Number )
return BOOLEAN is
--| Notes (none)
begin -- Test_Page
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
return INTEGER(Number_Of_Lines) <= Item.Page_Attr(Total_Lines) - (Item.
Page_Attr(Bottom_Margin) + Item.Page_Attr(Footer_Lines))
- INTEGER(Item.Line_Num);
end Test_Page;
-- ..................................
-- . .
-- . Set_Footer_Line . BODY
-- . .
-- ..................................
procedure Set_Footer_Line
( Item : in File;
Class : in Page_Kind;
Number : in Header_Footer_Line;
Left_Text : in STRING;
Center_Text : in STRING;
Right_Text : in STRING ) is
--| Notes (none)
begin -- Set_Footer_Line
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
case Class is
when Even_Pages =>
Dyn.Clear(Item.Even_Footer(Number, LEFT));
Item.Even_Footer(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Even_Footer(Number, CENTER));
Item.Even_Footer(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Even_Footer(Number, RIGHT));
Item.Even_Footer(Number, RIGHT) := Dyn.D_String(Right_Text);
when Odd_Pages =>
Dyn.Clear(Item.Odd_Footer(Number, LEFT));
Item.Odd_Footer(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Odd_Footer(Number, CENTER));
Item.Odd_Footer(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Odd_Footer(Number, RIGHT));
Item.Odd_Footer(Number, RIGHT) := Dyn.D_String(Right_Text);
when All_Pages =>
Dyn.Clear(Item.Even_Footer(Number, LEFT));
Item.Even_Footer(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Even_Footer(Number, CENTER));
Item.Even_Footer(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Even_Footer(Number, RIGHT));
Item.Even_Footer(Number, RIGHT) := Dyn.D_String(Right_Text);
Dyn.Clear(Item.Odd_Footer(Number, LEFT));
Item.Odd_Footer(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Odd_Footer(Number, CENTER));
Item.Odd_Footer(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Odd_Footer(Number, RIGHT));
Item.Odd_Footer(Number, RIGHT) := Dyn.D_String(Right_Text);
end case;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Set_Footer_Line);
end Set_Footer_Line;
-- ..................................
-- . .
-- . Set_Header_Line . BODY
-- . .
-- ..................................
procedure Set_Header_Line
( Item : in File;
Class : in Page_Kind;
Number : in Header_Footer_Line;
Left_Text : in STRING;
Center_Text : in STRING;
Right_Text : in STRING ) is
--| Notes (none)
begin -- Set_Header_Line
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
case Class is
when Even_Pages =>
Dyn.Clear(Item.Even_Header(Number, LEFT));
Item.Even_Header(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Even_Header(Number, CENTER));
Item.Even_Header(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Even_Header(Number, RIGHT));
Item.Even_Header(Number, RIGHT) := Dyn.D_String(Right_Text);
when Odd_Pages =>
Dyn.Clear(Item.Odd_Header(Number, LEFT));
Item.Odd_Header(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Odd_Header(Number, CENTER));
Item.Odd_Header(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Odd_Header(Number, RIGHT));
Item.Odd_Header(Number, RIGHT) := Dyn.D_String(Right_Text);
when All_Pages =>
Dyn.Clear(Item.Even_Header(Number, LEFT));
Item.Even_Header(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Even_Header(Number, CENTER));
Item.Even_Header(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Even_Header(Number, RIGHT));
Item.Even_Header(Number, RIGHT) := Dyn.D_String(Right_Text);
Dyn.Clear(Item.Odd_Header(Number, LEFT));
Item.Odd_Header(Number, LEFT) := Dyn.D_String(Left_Text);
Dyn.Clear(Item.Odd_Header(Number, CENTER));
Item.Odd_Header(Number, CENTER) := Dyn.D_String(Center_Text);
Dyn.Clear(Item.Odd_Header(Number, RIGHT));
Item.Odd_Header(Number, RIGHT) := Dyn.D_String(Right_Text);
end case;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Set_Header_Line);
end Set_Header_Line;
-- ..................................
-- . .
-- . Set_Page_Number_Id . BODY
-- . .
-- ..................................
procedure Set_Page_Number_Id
( Item : in File;
To : in CHARACTER ) is
--| Notes (none)
begin -- Set_Page_Number_Id
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
Item.Page_Number_Id := To;
end Set_Page_Number_Id;
-- ..................................
-- . .
-- . Set_Page_Number_Format . BODY
-- . .
-- ..................................
procedure Set_Page_Number_Format
( Item : in File;
To : in Numeric_Format ) is
--| Notes (none)
begin -- Set_Page_Number_Format
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
Item.Pn_Format := To;
end Set_Page_Number_Format;
-- ..................................
-- . .
-- . Page_Number_Format . BODY
-- . .
-- ..................................
function Page_Number_Format
( Item : in FILE )
return NUMERIC_FORMAT is
--| Notes (none)
begin -- Page_Number_Format
if not Item.Output_Is_Open then
raise File_Not_Open;
end if;
return Item.Pn_Format;
end Page_Number_Format;
end Formatted_Output_File;
--::::::::::
--idx_body.a
--::::::::::
-- **********************************
-- * *
-- * Index * BODY
-- * *
-- **********************************
with Command_Symbols;
with Error_Log;
with Output_File;
package body Index is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
File_Id
: Output_File.File_Type;
Is_Open
: BOOLEAN
:= false;
Line_Length
: NATURAL;
use Command_Symbols;
-- ..................................
-- . .
-- . Create . BODY
-- . .
-- ..................................
procedure Create
( File_Name : in STRING;
Line_Width : in NATURAL;
Text_Line_Width : in NATURAL;
Text_Line_Count : in NATURAL ) is
--| Notes (none)
begin -- Create
Output_File.Create(File_Id, File_Name);
Is_Open := true;
Line_Length := Line_Width;
Output_File.Put_Line(File_Id, NATURAL'Image(Text_Line_Width));
Output_File.Put_Line(File_Id, NATURAL'Image(Text_Line_Count));
exception -- Create
when others =>
raise Create_Error;
end Create;
-- ..................................
-- . .
-- . Add_Entry . BODY
-- . .
-- ..................................
procedure Add_Entry
( Text : in STRING;
Page_Number : in STRING ) is
--| Notes (none)
Line
: STRING (1 .. Line_Length)
:= (others => ' ');
Last
: NATURAL;
Limit
: NATURAL;
begin -- Add_Entry
if not Is_Open then
raise Index_File_Not_Open;
else
if Text'Length + Page_Number'Length > Line_Length then
Error_Log.Write_Warning(Warning_Index_Line_Truncation);
end if;
if Text'Length > Line_Length then
Last := Text'First + Line_Length - 1;
Limit := Line_Length;
else
Last := Text'Last;
Limit := Text'Length;
end if;
Line(1 .. Limit) := Text(Text'First .. Last);
if Page_Number'Length > Line_Length then
Last := Page_Number'First + Line_Length - 1;
Limit := 1;
else
Last := Page_Number'Last;
Limit := Line_Length - Page_Number'Length + 1;
end if;
Line(Limit .. Line_Length) := Page_Number(Text'First .. Last);
Output_File.Put_Line(File_Id, Line);
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Add_Index_Entry);
end Add_Entry;
-- ..................................
-- . .
-- . Close . BODY
-- . .
-- ..................................
procedure Close is
--| Notes (none)
begin -- Close
if Is_Open then
Output_File.Close(File_Id);
end if;
end Close;
end Index;
--::::::::::
--in_body.a
--::::::::::
-- **********************************
-- * *
-- * Input_File * BODY
-- * *
-- **********************************
with Text_IO;
package body Input_File is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
type FILE_OBJECT is
record
Is_Open : BOOLEAN := false;
File : Text_IO.File_Type;
end record;
-- ..................................
-- . .
-- . Open . BODY
-- . .
-- ..................................
procedure Open
( Id : in out File_Type;
File_Name : in STRING ) is
--| Notes (none)
begin -- Open
Id := new FILE_OBJECT;
Text_IO.Open(Id.File, Text_IO.In_File, File_Name);
Id.Is_Open := true;
exception -- Open -- Open
when others =>
raise Cannot_Open_Input_File;
end Open;
-- ..................................
-- . .
-- . Get_Line . BODY
-- . .
-- ..................................
procedure Get_Line
( Id : in out File_Type;
Item : out STRING;
Last : out NATURAL ) is
--| Notes (none)
begin -- Get_Line
if Id.Is_Open then
Text_IO.Get_Line(Id.File, Item, Last);
end if;
exception -- Get_Line -- Get_Line
when others =>
raise Read_Error;
end Get_Line;
-- ..................................
-- . .
-- . End_Of_File . BODY
-- . .
-- ..................................
function End_Of_File
( Id : in File_Type )
return BOOLEAN is
--| Notes (none)
begin -- End_Of_File
if Id.Is_Open then
return Text_IO.End_Of_File(Id.File);
end if;
exception -- End_Of_File -- End_Of_File
when others =>
raise Read_Error;
end End_Of_File;
-- ..................................
-- . .
-- . Close . BODY
-- . .
-- ..................................
procedure Close
( Id : in out File_Type ) is
--| Notes (none)
begin -- Close
if Id.Is_Open then
Text_IO.Close(Id.File);
end if;
end Close;
end Input_File;
--::::::::::
--mac_body.a
--::::::::::
-- **********************************
-- * *
-- * Macro * BODY
-- * *
-- **********************************
with Command_Symbols;
with Dyn;
with Error_Log;
with Variable;
package body Macro is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Init dummy ($n) parameters to null, not space
Macro_Name_String_Length
: constant
:= 20;
subtype MACRO_NAME_STRING is
STRING (1 .. Macro_Name_String_Length);
type MACRO_LINE;
type MACRO_LINE_POINTER is
access MACRO_LINE;
type MACRO_LINE is
record
Text : Dyn.Dyn_String;
Next : MACRO_LINE_POINTER;
end record;
type MODE is
( CREATE_MACRO, OPEN_MACRO, INACTIVE );
type MACRO_DEFINITION is
record
Macro_Name : MACRO_NAME_STRING;
Status : MODE := INACTIVE;
First_Line : MACRO_LINE_POINTER := null;
Next_Line : MACRO_LINE_POINTER := null;
Last_Line : MACRO_LINE_POINTER := null;
Next : Macro_Id := null;
end record;
First_Macro
: Macro_Id
:= null;
use Command_Symbols;
-- ..................................
-- . .
-- . Locate . SPEC & BODY
-- . .
-- ..................................
function Locate
( Macro_Name : in MACRO_NAME_STRING )
return Macro_Id is
--| Purpose
--| Locate is internal to the package Macro (as opposed to the
--| other Locate which returns a MACRO_STATUS, which is exported).
--| This Locate performs the same function as the other but
--| returns the MACRO_ID of the located macro. If the macro named
--| Macro_Name is not found, the value NULL is returned.
--|
--| Exceptions (none)
--| Notes (none)
Rover
: Macro_Id
:= First_Macro;
begin -- Locate
while Rover /= null loop
exit when Rover.Macro_Name = Macro_Name;
Rover := Rover.Next;
end loop;
return Rover;
end Locate;
-- ..................................
-- . .
-- . Convert . SPEC & BODY
-- . .
-- ..................................
function Convert
( Macro_Name : in STRING )
return MACRO_NAME_STRING is
--| Purpose
--| Convert is internal to the package Macro.
--| It converts the passed string to a MACRO_NAME_STRING.
--|
--| Exceptions (none)
--| Notes (none)
Res_Start
: constant NATURAL
:= Macro_Name'First;
Res_End
: constant NATURAL
:= Res_Start + Macro_Name_String_Length - 1;
Result
: MACRO_NAME_STRING
:= (others => ' ');
begin -- Convert
if Macro_Name'Length <= Macro_Name_String_Length then
Result(1 .. Macro_Name'Length) := Macro_Name;
else
Result := Macro_Name(Res_Start .. Res_End);
end if;
return Result;
end Convert;
-- ..................................
-- . .
-- . Create . BODY
-- . .
-- ..................................
procedure Create
( Macro_Name : in STRING;
Id : in out Macro_Id;
Status : out Macro_Status ) is
--| Notes (none)
Fill_String
: constant MACRO_NAME_STRING
:= (others => ' ');
Limit
: INTEGER
:= Macro_Name_String_Length - Macro_Name'Length;
begin -- Create
Id := new MACRO_DEFINITION;
Id.Macro_Name := Convert(Macro_Name);
Id.Status := CREATE_MACRO;
Status := Ok;
exception -- Create -- Create
when others =>
Status := Not_Ok;
end Create;
-- ..................................
-- . .
-- . Write . BODY
-- . .
-- ..................................
procedure Write
( Id : in out Macro_Id;
Line : in STRING ) is
--| Notes (none)
begin -- Write
if Id.Status /= CREATE_MACRO then
raise Macro_Not_In_Add_Mode;
end if;
if Id.Last_Line = null then
Id.Last_Line := new MACRO_LINE;
Id.First_Line := Id.Last_Line;
else
Id.Last_Line.Next := new MACRO_LINE;
Id.Last_Line := Id.Last_Line.Next;
end if;
Id.Last_Line.Text := Dyn.D_String(Line);
exception
when others =>
Error_Log.Write_Error(Error_Internal_Macro_Write);
end Write;
-- ..................................
-- . .
-- . Open . BODY
-- . .
-- ..................................
procedure Open
( Macro_Name : in STRING;
Id : out Macro_Id;
Status : out Macro_Status ) is
--| Notes (none)
Search_Result
: Macro_Id;
begin -- Open
Search_Result := Locate(Convert(Macro_Name));
if Search_Result = null then
Status := Not_Ok;
else
Status := Ok;
end if;
Id := Search_Result;
if Search_Result /= null then
Search_Result.Status := OPEN_MACRO;
Search_Result.Next_Line := Search_Result.First_Line;
end if;
end Open;
-- ..................................
-- . .
-- . Is_Empty . BODY
-- . .
-- ..................................
function Is_Empty
( Id : in Macro_Id )
return BOOLEAN is
--| Notes (none)
begin -- Is_Empty
if Id.Status /= OPEN_MACRO then
raise Macro_Not_Open;
end if;
return Id.Next_Line = null;
end Is_Empty;
-- ..................................
-- . .
-- . Read . BODY
-- . .
-- ..................................
procedure Read
( Id : in out Macro_Id;
Item : out STRING;
Last : out NATURAL ) is
--| Notes (none)
Local_Last
: NATURAL;
begin -- Read
if Id.Status /= OPEN_MACRO then
raise Macro_Not_Open;
end if;
if Id.Next_Line = null then
Item(Item'First .. Item'First) := " ";
Last := Item'First - 1;
else
Local_Last := Dyn.Length(Id.Next_Line.Text) + Item'First - 1;
Item(Item'First .. Local_Last) := Dyn.Str(Id.Next_Line.Text);
Last := Local_Last;
Id.Next_Line := Id.Next_Line.Next;
end if;
end Read;
-- ..................................
-- . .
-- . Close . BODY
-- . .
-- ..................................
procedure Close
( Id : in out Macro_Id ) is
--| Notes
--| If the Id is in Create mode, Close adds it to the front of the
--| main list.
begin -- Close
if Id.Status = CREATE_MACRO then
if First_Macro = null then
First_Macro := Id;
else
Id.Next := First_Macro; -- add to front of list
First_Macro := Id;
end if;
end if;
Id.Status := INACTIVE;
end Close;
-- ..................................
-- . .
-- . Locate . BODY
-- . .
-- ..................................
function Locate
( Macro_Name : in STRING )
return Macro_Status is
--| Notes (none)
Result
: Macro_Id;
begin -- Locate
Result := Locate(Convert(Macro_Name));
if Result /= null then
return Ok;
else
return Not_Ok;
end if;
end Locate;
-- ..................................
-- . .
-- . Define_Parameters . BODY
-- . .
-- ..................................
procedure Define_Parameters
( Macro_Name : in STRING;
Parameters : in STRING ) is
--| Notes (none)
Start
: NATURAL;
Stop
: NATURAL;
Number
: STRING (1 .. 1)
:= "1";
type PARSE_STATE is
( IN_TEXT, IN_LAST, NOT_IN_TEXT );
State
: PARSE_STATE
:= NOT_IN_TEXT;
begin -- Define_Parameters
Variable.Set_Var("0", Macro_Name);
for I in Parameters'range loop
case State is
when NOT_IN_TEXT =>
if Parameters(I) > ' ' then
if Number(1) = '9' then
State := IN_LAST;
else
State := IN_TEXT;
end if;
Start := I;
end if;
when IN_LAST =>
null;
when IN_TEXT =>
if Parameters(I) <= ' ' then
Stop := I - 1;
Variable.Set_Var(Number, Parameters(Start .. Stop));
Number(1) := CHARACTER'Succ(Number(1));
State := NOT_IN_TEXT;
end if;
end case;
end loop;
if (State = IN_LAST) or (State = IN_TEXT) then
Variable.Set_Var(Number, Parameters(Start .. Parameters'Last));
else
Variable.Set_Var(Number, " ");
end if;
while Number(1) /= '9' loop
Number(1) := CHARACTER'Succ(Number(1));
Variable.Set_Var(Number, " ");
end loop;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Macro_Define);
end Define_Parameters;
end Macro;
--::::::::::
--out_body.a
--::::::::::
-- **********************************
-- * *
-- * Output_File * BODY
-- * *
-- **********************************
with Text_IO;
package body Output_File is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Fix bug in Already_Exists test
type FILE_OBJECT is
record
File : Text_IO.File_Type;
Is_Open : BOOLEAN := false;
Is_Output_Enabled : BOOLEAN := true;
end record;
-- ..................................
-- . .
-- . Already_Exists . BODY
-- . .
-- ..................................
function Already_Exists
( File_Name : in STRING )
return BOOLEAN is
--| Notes (none)
File
: Text_IO.File_Type;
Result
: BOOLEAN
:= true;
begin -- Already_Exists
begin
Text_IO.Open(File, Text_IO.In_File, File_Name);
Text_IO.Close(File);
exception
when others =>
Result := false;
end;
return Result;
end Already_Exists;
-- ..................................
-- . .
-- . Delete . BODY
-- . .
-- ..................................
function Delete
( File_Name : in STRING )
return BOOLEAN is
--| Notes (none)
File
: Text_IO.File_Type;
Result
: BOOLEAN
:= true;
begin -- Delete
begin
if Already_Exists(File_Name) then
Text_IO.Open(File, Text_IO.Out_File, File_Name);
Text_IO.Delete(File);
end if;
exception
when others =>
Result := false;
end;
return Result;
end Delete;
-- ..................................
-- . .
-- . Create . BODY
-- . .
-- ..................................
procedure Create
( Id : in out File_Type;
File_Name : in STRING ) is
--| Notes (none)
begin -- Create
Id := new FILE_OBJECT;
Text_IO.Create(Id.File, Text_IO.Out_File, File_Name);
Id.Is_Open := true;
Id.Is_Output_Enabled := true;
exception -- Create -- Create
when others =>
raise Cannot_Create_Output_File;
end Create;
-- ..................................
-- . .
-- . Put . BODY
-- . .
-- ..................................
procedure Put
( Id : in out File_Type;
Item : in CHARACTER ) is
--| Notes (none)
begin -- Put
if Id.Is_Open and Id.Is_Output_Enabled then
Text_IO.Put(Id.File, Item);
end if;
exception -- Put -- Put
when others =>
raise Write_Error;
end Put;
-- ..................................
-- . .
-- . Put . BODY
-- . .
-- ..................................
procedure Put
( Id : in out File_Type;
Item : in STRING ) is
--| Notes (none)
begin -- Put
if Id.Is_Open and Id.Is_Output_Enabled then
Text_IO.Put(Id.File, Item);
end if;
exception -- Put -- Put
when others =>
raise Write_Error;
end Put;
-- ..................................
-- . .
-- . Put_Line . BODY
-- . .
-- ..................................
procedure Put_Line
( Id : in out File_Type;
Item : in STRING ) is
--| Notes (none)
begin -- Put_Line
if Id.Is_Open and Id.Is_Output_Enabled then
Text_IO.Put_Line(Id.File, Item);
end if;
exception -- Put_Line -- Put_Line
when others =>
raise Write_Error;
end Put_Line;
-- ..................................
-- . .
-- . New_Line . BODY
-- . .
-- ..................................
procedure New_Line
( Id : in out File_Type ) is
--| Notes (none)
begin -- New_Line
if Id.Is_Open and Id.Is_Output_Enabled then
Text_IO.New_Line(Id.File);
end if;
exception -- New_Line -- New_Line
when others =>
raise Write_Error;
end New_Line;
-- ..................................
-- . .
-- . New_Page . BODY
-- . .
-- ..................................
procedure New_Page
( Id : in out File_Type ) is
--| Notes (none)
begin -- New_Page
if Id.Is_Open and Id.Is_Output_Enabled then
Text_IO.New_Page(Id.File);
end if;
exception -- New_Page -- New_Page
when others =>
raise Write_Error;
end New_Page;
-- ..................................
-- . .
-- . Enable_Output . BODY
-- . .
-- ..................................
procedure Enable_Output
( Id : in out File_Type ) is
--| Notes (none)
begin -- Enable_Output
Id.Is_Output_Enabled := true;
end Enable_Output;
-- ..................................
-- . .
-- . Disable_Output . BODY
-- . .
-- ..................................
procedure Disable_Output
( Id : in out File_Type ) is
--| Notes (none)
begin -- Disable_Output
Id.Is_Output_Enabled := false;
end Disable_Output;
-- ..................................
-- . .
-- . Close . BODY
-- . .
-- ..................................
procedure Close
( Id : in out File_Type ) is
--| Notes (none)
begin -- Close
if Id.Is_Open then
Text_IO.Close(Id.File);
end if;
end Close;
end Output_File;
--::::::::::
--var_body.a
--::::::::::
-- **********************************
-- * *
-- * Variable * BODY
-- * *
-- **********************************
with Command_Symbols;
with Dyn;
with Error_Log;
package body Variable is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
Ap_Flag
: BOOLEAN
:= Default_Auto_Paragraph;
Bd_Count
: NATURAL
:= 0;
Ce_Count
: NATURAL
:= 0;
Ul_Count
: NATURAL
:= 0;
Cc_Char
: CHARACTER
:= Default_Cc;
Ec_Char
: CHARACTER
:= Default_Ec;
Fc_Char
: CHARACTER
:= Default_Fc;
type NREG_ARRAY is
array (Nreg)
of NATURAL;
Number
: NREG_ARRAY
:= (others => 0);
Input_File_Name
: STRING (1 .. 100);
Input_File_Name_Last
: NATURAL;
File_Line_Number
: NATURAL;
Var_Name_String_Length
: constant
:= 20;
subtype VAR_NAME_STRING is
STRING (1 .. Var_Name_String_Length);
type VAR_DEFINITION;
type VAR_LIST_POINTER is
access VAR_DEFINITION;
type VAR_DEFINITION is
record
Var_Name : VAR_NAME_STRING;
Text : Dyn.Dyn_String;
Next : VAR_LIST_POINTER := null;
end record;
First_Var
: VAR_LIST_POINTER
:= null;
use Command_Symbols;
-- ..................................
-- . .
-- . Set_Auto_Paragraph . BODY
-- . .
-- ..................................
procedure Set_Auto_Paragraph
( Item : in BOOLEAN ) is
--| Notes (none)
begin -- Set_Auto_Paragraph
Ap_Flag := Item;
end Set_Auto_Paragraph;
-- ..................................
-- . .
-- . Is_Auto_Paragraph . BODY
-- . .
-- ..................................
function Is_Auto_Paragraph
return BOOLEAN is
--| Notes (none)
begin -- Is_Auto_Paragraph
return Ap_Flag;
end Is_Auto_Paragraph;
-- ..................................
-- . .
-- . Set_Bold_Count . BODY
-- . .
-- ..................................
procedure Set_Bold_Count
( Value : in NATURAL ) is
--| Notes (none)
begin -- Set_Bold_Count
Bd_Count := Value;
end Set_Bold_Count;
-- ..................................
-- . .
-- . Bold_Count . BODY
-- . .
-- ..................................
function Bold_Count
return NATURAL is
--| Notes (none)
begin -- Bold_Count
return Bd_Count;
end Bold_Count;
-- ..................................
-- . .
-- . Set_Center_Count . BODY
-- . .
-- ..................................
procedure Set_Center_Count
( Value : in NATURAL ) is
--| Notes (none)
begin -- Set_Center_Count
Ce_Count := Value;
end Set_Center_Count;
-- ..................................
-- . .
-- . Center_Count . BODY
-- . .
-- ..................................
function Center_Count
return NATURAL is
--| Notes (none)
begin -- Center_Count
return Ce_Count;
end Center_Count;
-- ..................................
-- . .
-- . Set_Underline_Count . BODY
-- . .
-- ..................................
procedure Set_Underline_Count
( Value : in NATURAL ) is
--| Notes (none)
begin -- Set_Underline_Count
Ul_Count := Value;
end Set_Underline_Count;
-- ..................................
-- . .
-- . Underline_Count . BODY
-- . .
-- ..................................
function Underline_Count
return NATURAL is
--| Notes (none)
begin -- Underline_Count
return Ul_Count;
end Underline_Count;
-- ..................................
-- . .
-- . Set_Cc . BODY
-- . .
-- ..................................
procedure Set_Cc
( Item : in CHARACTER ) is
--| Notes (none)
begin -- Set_Cc
Cc_Char := Item;
end Set_Cc;
-- ..................................
-- . .
-- . Cc . BODY
-- . .
-- ..................................
function Cc
return CHARACTER is
--| Notes (none)
begin -- Cc
return Cc_Char;
end Cc;
-- ..................................
-- . .
-- . Set_Ec . BODY
-- . .
-- ..................................
procedure Set_Ec
( Item : in CHARACTER ) is
--| Notes (none)
begin -- Set_Ec
Ec_Char := Item;
end Set_Ec;
-- ..................................
-- . .
-- . Ec . BODY
-- . .
-- ..................................
function Ec
return CHARACTER is
--| Notes (none)
begin -- Ec
return Ec_Char;
end Ec;
-- ..................................
-- . .
-- . Set_Fc . BODY
-- . .
-- ..................................
procedure Set_Fc
( Item : in CHARACTER ) is
--| Notes (none)
begin -- Set_Fc
Fc_Char := Item;
end Set_Fc;
-- ..................................
-- . .
-- . Fc . BODY
-- . .
-- ..................................
function Fc
return CHARACTER is
--| Notes (none)
begin -- Fc
return Fc_Char;
end Fc;
-- ..................................
-- . .
-- . Set_Nr . BODY
-- . .
-- ..................................
procedure Set_Nr
( Item : in Nreg;
Value : in NATURAL ) is
--| Notes (none)
begin -- Set_Nr
Number(Item) := Value;
end Set_Nr;
-- ..................................
-- . .
-- . Nr . BODY
-- . .
-- ..................................
function Nr
( Item : in Nreg )
return NATURAL is
--| Notes (none)
begin -- Nr
return Number(Item);
end Nr;
-- ..................................
-- . .
-- . Nr . BODY
-- . .
-- ..................................
procedure Nr
( Item : in Nreg;
Value : out STRING;
Last : out NATURAL ) is
--| Notes (none)
Buffer
: STRING (1 .. 20);
Length
: NATURAL;
Temp_Last
: NATURAL;
-- ..................................
-- . .
-- . Nr.Set_Buffer . SPEC & BODY
-- . .
-- ..................................
procedure Set_Buffer
( Value : in STRING ) is
--| Notes (none)
begin -- Set_Buffer
Buffer(1 .. Value'Length) := Value;
Length := Value'Length;
end Set_Buffer;
begin -- Nr
Set_Buffer(NATURAL'Image(Nr(Item)));
Temp_Last := Value'First + Length - 2;
Value(Value'First .. Temp_Last) := Buffer(2 .. Length);
Last := Temp_Last;
end Nr;
-- ..................................
-- . .
-- . Convert . SPEC & BODY
-- . .
-- ..................................
function Convert
( Var_Name : in STRING )
return VAR_NAME_STRING is
--| Purpose
--| Convert is internal to the package Variable.
--| It converts the passed string to a VAR_NAME_STRING.
--|
--| Exceptions (none)
--| Notes (none)
Res_Start
: constant NATURAL
:= Var_Name'First;
Res_End
: constant NATURAL
:= Res_Start + Var_Name_String_Length - 1;
Result
: VAR_NAME_STRING
:= (others => ' ');
begin -- Convert
if Var_Name'Length <= Var_Name_String_Length then
Result(1 .. Var_Name'Length) := Var_Name;
else
Result := Var_Name(Res_Start .. Res_End);
end if;
return Result;
end Convert;
-- ..................................
-- . .
-- . Locate . SPEC & BODY
-- . .
-- ..................................
function Locate
( Var_Name : in VAR_NAME_STRING )
return VAR_LIST_POINTER is
--| Purpose
--| Locate is internal to the package Variable.
--| It returns a pointer to the named variable or NULL if not found.
--|
--| Exceptions (none)
--| Notes (none)
Rover
: VAR_LIST_POINTER
:= First_Var;
begin -- Locate
while Rover /= null loop
exit when Rover.Var_Name = Var_Name;
Rover := Rover.Next;
end loop;
return Rover;
end Locate;
-- ..................................
-- . .
-- . Set_Var . BODY
-- . .
-- ..................................
procedure Set_Var
( Name : in STRING;
Value : in STRING ) is
--| Notes (none)
Target
: VAR_NAME_STRING
:= Convert(Name);
Target_Pointer
: VAR_LIST_POINTER
:= Locate(Target);
Temp
: VAR_LIST_POINTER;
begin -- Set_Var
if Target_Pointer = null then
Temp := new VAR_DEFINITION;
Temp.Var_Name := Target;
Temp.Text := Dyn.D_String(Value);
Temp.Next := First_Var;
First_Var := Temp;
else
Dyn.Clear(Target_Pointer.Text);
Target_Pointer.Text := Dyn.D_String(Value);
end if;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Set_Var);
end Set_Var;
-- ..................................
-- . .
-- . Var . BODY
-- . .
-- ..................................
function Var
( Name : in STRING )
return STRING is
--| Notes (none)
Target
: VAR_NAME_STRING
:= Convert(Name);
Target_Pointer
: VAR_LIST_POINTER
:= Locate(Target);
begin -- Var
if Target_Pointer = null then
return "";
else
return Dyn.Str(Target_Pointer.Text);
end if;
end Var;
-- ..................................
-- . .
-- . Var . BODY
-- . .
-- ..................................
procedure Var
( Name : in STRING;
Value : out STRING;
Last : out NATURAL ) is
--| Notes (none)
Target
: VAR_NAME_STRING
:= Convert(Name);
Tp
: VAR_LIST_POINTER
:= Locate(Target);
Local_Last
: NATURAL;
begin -- Var
if Tp = null then
Last := Value'First - 1;
Value(Value'First) := ' ';
else
Local_Last := Dyn.Length(Tp.Text) + Value'First - 1;
Value(Value'First .. Local_Last) := Dyn.Str(Tp.Text);
Last := Local_Last;
end if;
end Var;
-- ..................................
-- . .
-- . Set_File_Name . BODY
-- . .
-- ..................................
procedure Set_File_Name
( Name : in STRING ) is
--| Notes (none)
begin -- Set_File_Name
if Name'Length <= Input_File_Name'Length then
Input_File_Name(1 .. Name'Length) := Name;
Input_File_Name_Last := Name'Length;
else
Input_File_Name := Name(Name'First .. Name'First
+ Input_File_Name'Length - 1);
Input_File_Name_Last := Input_File_Name'Length;
end if;
File_Line_Number := 0;
end Set_File_Name;
-- ..................................
-- . .
-- . Get_File_Name . BODY
-- . .
-- ..................................
function Get_File_Name
return STRING is
--| Notes (none)
begin -- Get_File_Name
return Input_File_Name(1 .. Input_File_Name_Last);
end Get_File_Name;
-- ..................................
-- . .
-- . Set_Line_Number . BODY
-- . .
-- ..................................
procedure Set_Line_Number
( Value : in NATURAL ) is
--| Notes (none)
begin -- Set_Line_Number
File_Line_Number := Value;
end Set_Line_Number;
-- ..................................
-- . .
-- . Increment_Line_Number . BODY
-- . .
-- ..................................
procedure Increment_Line_Number is
--| Notes (none)
begin -- Increment_Line_Number
File_Line_Number := File_Line_Number + 1;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Increment);
end Increment_Line_Number;
-- ..................................
-- . .
-- . Line_Number . BODY
-- . .
-- ..................................
function Line_Number
return NATURAL is
--| Notes (none)
begin -- Line_Number
return File_Line_Number;
end Line_Number;
end Variable;
--::::::::::
--wp_body.a
--::::::::::
-- **********************************
-- * *
-- * Word_Processor * BODY
-- * *
-- **********************************
with Command;
with Command_Symbols;
with Error_Log;
with Formatted_Output_File;
with Macro;
with Parse;
with Variable;
with Input_File;
package body Word_Processor is
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Add Disable Underlining Flag
--| 02/26/90 Rick Conn Remove trailing spaces from variables
use Command; -- for visibility of "="
use Command_Symbols;
use Formatted_Output_File;
use Macro;
Max_Line_Length
: constant
:= 400;
Output_File
: Formatted_Output_File.File;
Is_Open
: BOOLEAN
:= false;
Last_Line_Was_Blank
: BOOLEAN
:= true;
package Cmd
renames Command;
package Csym
renames Command_Symbols;
package Fof
renames Formatted_Output_File;
-- ..................................
-- . .
-- . Expand . SPEC & BODY
-- . .
-- ..................................
procedure Expand
( In_Out_Line : in out STRING;
Last : in out NATURAL ) is
--| Purpose
--| Expand expands the line in the buffer Inline, expanding tabs into
--| spaces, replacing number register references with the appropriate
--| values, and replacing variable name references with the appropriate
--| values. The result is placed back into Inline and Inlast.
--| This procedure is internal to Wp_Body.
--|
--| Exceptions (none)
--| Notes (not done)
Temp
: STRING (1 .. In_Out_Line'Length);
Temp_Last
: NATURAL
:= 0;
Var
: STRING (1 .. In_Out_Line'Length);
Var_Last
: NATURAL;
Result_Last
: NATURAL;
Rover
: NATURAL
:= In_Out_Line'First;
type EXPANSION_STATE is
( IN_TEXT, IN_ESCAPE, IN_BRACED_VARIABLE, IN_VARIABLE );
Current_State
: EXPANSION_STATE
:= IN_TEXT;
-- ..................................
-- . .
-- . Expand.Expand_Variable . SPEC & BODY
-- . .
-- ..................................
procedure Expand_Variable is
--| Purpose
--| Expand_Variable locates the current variable and places
--| its value into the output.
--|
--| Exceptions (none)
--| Notes (none)
Value
: STRING (1 .. In_Out_Line'Length);
Value_Last
: NATURAL;
Value_First
: NATURAL;
Value_Last_Temp
: NATURAL;
begin -- Expand_Variable
if (Var_Last = 2) then
if (Var(1) = 'n') and (Var(2) in Variable.Nreg) then
Variable.Nr(Var(2), Value, Value_Last);
else
Variable.Var(Var(1 .. Var_Last), Value, Value_Last);
end if;
else
Variable.Var(Var(1 .. Var_Last), Value, Value_Last);
end if;
if Value_Last > 0 then
Value_Last_Temp := 0;
for I in reverse 1 .. Value_Last loop
-- remove trailing spaces
if Value(I) > ' ' then
Value_Last_Temp := I;
exit;
end if;
end loop;
Value_Last := Value_Last_Temp;
Value_First := Value_Last + 1;
for I in 1 .. Value_Last loop
-- remove leading spaces
if Value(I) > ' ' then
Value_First := I;
exit;
end if;
end loop;
for I in Value_First .. Value_Last loop
Temp_Last := Temp_Last + 1;
Temp(Temp_Last) := Value(I);
end loop;
else
Error_Log.Write_Error(Error_Variable_Name);
end if;
end Expand_Variable;
-- ..................................
-- . .
-- . Expand.Process_In_Text . SPEC & BODY
-- . .
-- ..................................
procedure Process_In_Text
( Index : in NATURAL ) is
--| Purpose
--| Process_In_Text performs the character processing and state
--| switching required when the Current_State is processing a
--| text character as opposed to a variable character. This can
--| happen in any of the three EXPANSION_STATEs.
--|
--| Exceptions (none)
--| Notes (none)
begin -- Process_In_Text
if In_Out_Line(Index) = Ascii.Ht then
Temp_Last := Temp_Last + 1;
Temp(Temp_Last) := ' ';
while Temp_Last mod 8 /= 1 loop
Temp_Last := Temp_Last + 1;
Temp(Temp_Last) := ' ';
end loop;
else
if In_Out_Line(Index) = Variable.Fc then
Current_State := IN_VARIABLE;
Var_Last := 0;
else
if In_Out_Line(Index) = Variable.Ec then
Current_State := IN_ESCAPE;
else
Temp_Last := Temp_Last + 1;
Temp(Temp_Last) := In_Out_Line(Index);
end if;
end if;
end if;
end Process_In_Text;
begin -- Expand
for I in In_Out_Line'First .. Last loop
case Current_State is
when IN_ESCAPE =>
Temp_Last := Temp_Last + 1;
Temp(Temp_Last) := In_Out_Line(I);
Current_State := IN_TEXT;
when IN_TEXT =>
Process_In_Text(I);
when IN_BRACED_VARIABLE =>
if In_Out_Line(I) = '}' then
Expand_Variable;
Current_State := IN_TEXT;
else
Var_Last := Var_Last + 1;
Var(Var_Last) := In_Out_Line(I);
end if;
when IN_VARIABLE =>
if In_Out_Line(I) = '{' then
Current_State := IN_BRACED_VARIABLE;
else
if ((In_Out_Line(I) >= '0') and (In_Out_Line(I) <= '9'))
or ((In_Out_Line(I) >= 'a') and (In_Out_Line(I) <= 'z'))
or ((In_Out_Line(I) >= 'A') and (In_Out_Line(I) <= 'Z'))
then
Var_Last := Var_Last + 1;
Var(Var_Last) := In_Out_Line(I);
else
Expand_Variable;
Current_State := IN_TEXT;
Process_In_Text(I);
end if;
end if;
end case;
end loop;
if (Current_State = IN_VARIABLE) or (Current_State = IN_BRACED_VARIABLE)
then
Expand_Variable;
end if;
Result_Last := In_Out_Line'First + Temp_Last - 1;
In_Out_Line(In_Out_Line'First .. Result_Last) := Temp(1 .. Temp_Last);
Last := In_Out_Line'First - 1;
for I in reverse In_Out_Line'First .. Result_Last loop
if In_Out_Line(I) > ' ' then
Last := I;
exit;
end if;
end loop;
exception -- Expand
when others =>
Error_Log.Write_Error(Error_Expansion);
end Expand;
-- ..................................
-- . .
-- . Open_Output_File . BODY
-- . .
-- ..................................
function Open_Output_File
( File_Name : in STRING;
Page_Offset : in NATURAL;
Disable_Bolding : in BOOLEAN;
Disable_Underlining : in BOOLEAN )
return Operation_Status is
--| Notes (none)
Result
: Fof.Status;
Returned_Result
: Operation_Status
:= Ok;
begin -- Open_Output_File
if not Is_Open then
Fof.Open(Output_File, File_Name, Result);
if Result = Fof.Not_Ok then
Returned_Result := Not_Ok;
else
Is_Open := true;
Returned_Result := Ok;
Fof.Set_Page_Attribute(Output_File, Fof.Page_Offset, Page_Offset);
if Disable_Bolding then
Command.Disable_Bolding;
end if;
if Disable_Underlining then
Command.Disable_Underlining;
end if;
end if;
else
Returned_Result := Not_Ok;
end if;
return Returned_Result;
exception
when others =>
Error_Log.Write_Error(Error_Internal_Open);
return Not_Ok;
end Open_Output_File;
-- ..................................
-- . .
-- . Process_Source_File . BODY
-- . .
-- ..................................
function Process_Source_File
( File_Name : in STRING )
return Operation_Status is
--| Notes (none)
File_Id
: Input_File.File_Type;
Result
: Operation_Status
:= Ok;
My_Cmd
: Csym.Command_Id;
My_Macro
: Macro.Macro_Id;
Mresult
: Macro.Macro_Status;
subtype LINE is
STRING (1 .. Max_Line_Length);
Inline
: LINE;
Inlast
: NATURAL;
Verb
: LINE;
Cvlast
: NATURAL;
Tail
: LINE;
Ctlast
: NATURAL;
Current_Line_Number
: NATURAL;
type OPERATIONAL_STATE is
( IN_MACRO, IN_TEXT );
State
: OPERATIONAL_STATE
:= IN_TEXT;
-- ..................................
-- . .
-- . Process_Source_File.Is_Blank . BODY
-- . .
-- ..................................
function Is_Blank
( Item : in STRING )
return BOOLEAN is
--| Purpose
--| Is_Blank determines if the indicated string contains any
--| non-white characters.
--|
--| Exceptions (none)
--| Notes (none)
Result
: BOOLEAN
:= true;
begin -- Is_Blank
for I in Item'range loop
if Item(I) > ' ' then
Result := false;
exit;
end if;
end loop;
return Result;
end Is_Blank;
begin -- Process_Source_File
begin
Input_File.Open(File_Id, File_Name);
exception
when others =>
Result := Not_Ok;
end;
Variable.Set_File_Name(File_Name);
if Result = Ok then
while (not Input_File.End_Of_File(File_Id)) or (State = IN_MACRO) loop
if State = IN_TEXT then
Input_File.Get_Line(File_Id, Inline, Inlast);
Variable.Increment_Line_Number;
else
if not Macro.Is_Empty(My_Macro) then
Macro.Read(My_Macro, Inline, Inlast);
else
Macro.Close(My_Macro);
State := IN_TEXT;
exit when Input_File.End_Of_File(File_Id);
Input_File.Get_Line(File_Id, Inline, Inlast);
Variable.Increment_Line_Number;
end if;
end if;
if Inlast > 0 and then not Is_Blank(Inline(1 .. Inlast)) then
-- Line is not blank
Expand(Inline, Inlast);
if Inline(1) /= Variable.Cc then
-- Line is not a dot command
if Variable.Is_Auto_Paragraph then
if Last_Line_Was_Blank or (Inline(1) <= ' ') then
Fof.Skip(Output_File, 1);
Cmd.Process(Csym.Temporary_Indent, "+5", Output_File,
File_Id);
end if;
end if;
Fof.Put_Line(Output_File, Inline(1 .. Inlast));
if Variable.Bold_Count > 0 then
Variable.Set_Bold_Count(Variable.Bold_Count - 1);
if Variable.Bold_Count = 0 then
Fof.Set_Line_Attribute(Output_File, Fof.Bold, Fof.Off);
end if;
end if;
if Variable.Bold_Count > 0 then
Variable.Set_Bold_Count(Variable.Bold_Count - 1);
if Variable.Bold_Count = 0 then
Fof.Set_Line_Attribute(Output_File, Fof.Bold, Fof.Off);
end if;
end if;
if Variable.Center_Count > 0 then
Variable.Set_Center_Count(Variable.Center_Count - 1);
if Variable.Center_Count = 0 then
Fof.Set_Line_Attribute(Output_File, Fof.Center, Fof.Off);
end if;
end if;
if Variable.Underline_Count > 0 then
Variable.Set_Underline_Count(Variable.Underline_Count - 1);
if Variable.Underline_Count = 0 then
Fof.Set_Line_Attribute(Output_File, Fof.Underline, Fof.Off);
end if;
end if;
else
-- Line is a dot command
Parse(Inline(2 .. Inlast), Verb, Tail, Cvlast, Ctlast);
if Macro.Locate(Verb(1 .. Cvlast)) = Macro.Ok then
Macro.Open(Verb(1 .. Cvlast), My_Macro, Mresult);
if Mresult = Macro.Ok then
State := IN_MACRO;
end if;
Macro.Define_Parameters(Verb(1 .. Cvlast), Tail(1 .. Ctlast));
else
My_Cmd := Cmd.Identify(Verb(1 .. Cvlast));
if My_Cmd /= Csym.Unknown then
if My_Cmd = Csym.Include then
Current_Line_Number := Variable.Line_Number;
end if;
Cmd.Process(My_Cmd, Tail(1 .. Ctlast), Output_File, File_Id);
if My_Cmd = Csym.Include then
Variable.Set_File_Name(File_Name);
Variable.Set_Line_Number(Current_Line_Number);
end if;
else
Error_Log.Write_Error(Error_Unknown);
end if;
end if;
end if;
Last_Line_Was_Blank := false;
else
-- Line is blank
if Fof.Get_Line_Attribute(Output_File, Fof.Fill) = Fof.Off then
Fof.Put_Line(Output_File, "");
end if;
Last_Line_Was_Blank := true;
if Variable.Bold_Count > 0 then
Variable.Set_Bold_Count(Variable.Bold_Count - 1);
if Variable.Bold_Count = 0 then
Fof.Set_Line_Attribute(Output_File, Fof.Bold, Fof.Off);
end if;
end if;
if Variable.Center_Count > 0 then
Variable.Set_Center_Count(Variable.Center_Count - 1);
if Variable.Center_Count = 0 then
Fof.Set_Line_Attribute(Output_File, Fof.Center, Fof.Off);
end if;
end if;
if Variable.Underline_Count > 0 then
Variable.Set_Underline_Count(Variable.Underline_Count - 1);
if Variable.Underline_Count = 0 then
Fof.Set_Line_Attribute(Output_File, Fof.Underline, Fof.Off);
end if;
end if;
end if;
end loop;
Input_File.Close(File_Id);
end if;
return Result;
exception
when others =>
return Not_Ok;
end Process_Source_File;
-- ..................................
-- . .
-- . Close_Output_File . BODY
-- . .
-- ..................................
procedure Close_Output_File is
--| Notes (none)
begin -- Close_Output_File
Fof.Close(Output_File);
Is_Open := false;
end Close_Output_File;
end Word_Processor;